[multiple changes]

2015-10-23  Arnaud Charlet  <charlet@adacore.com>

	* s-taskin.ads: Minor code clean up.
	(Ada_Task_Control_Block): Move fixed size field before variable sized
	ones.
	* einfo.ads: Minor editing.

2015-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Aggregate_Accessibility): Apply rule in RM
	6.5 (8.3) to verify that access discriminants in an aggregate
	in a return statement have the proper accessibility, i.e. do
	not lead to dangling references.

2015-10-23  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Add missing
	test on Address_Clause_Overlay_Warnings to the "constant overlays
	variable" warning. For the reverse case, also issue a warning if
	the modification is potentially made through the initialization
	of the variable.

2015-10-23  Jose Ruiz  <ruiz@adacore.com>

	* a-exetim-posix.adb (Clock): Use the pthread_getcpuclockid
	function to have access to CPU clocks for tasks other than the
	calling task.

From-SVN: r229247

6 files changed, 144 insertions, 17 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bf8ad25..9490427 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2015-10-23  Arnaud Charlet  <charlet@adacore.com>
+
+	* s-taskin.ads: Minor code clean up.
+	(Ada_Task_Control_Block): Move fixed size field before variable sized
+	ones.
+	* einfo.ads: Minor editing.
+
+2015-10-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Check_Aggregate_Accessibility): Apply rule in RM
+	6.5 (8.3) to verify that access discriminants in an aggregate
+	in a return statement have the proper accessibility, i.e. do
+	not lead to dangling references.
+
+2015-10-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Add missing
+	test on Address_Clause_Overlay_Warnings to the "constant overlays
+	variable" warning. For the reverse case, also issue a warning if
+	the modification is potentially made through the initialization
+	of the variable.
+
+2015-10-23  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-exetim-posix.adb (Clock): Use the pthread_getcpuclockid
+	function to have access to CPU clocks for tasks other than the
+	calling task.
+
 2015-10-23  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* debug.adb: Switch -gnatd.5 is no longer in use, remove the
diff --git a/gcc/ada/a-exetim-posix.adb b/gcc/ada/a-exetim-posix.adb
index 9dc709a..9c7ad57 100644
--- a/gcc/ada/a-exetim-posix.adb
+++ b/gcc/ada/a-exetim-posix.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2007-2012, Free Software Foundation, Inc.          --
+--         Copyright (C) 2007-2015, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -34,8 +34,9 @@
 with Ada.Task_Identification;  use Ada.Task_Identification;
 with Ada.Unchecked_Conversion;
 
-with System.OS_Constants; use System.OS_Constants;
+with System.Tasking;
 with System.OS_Interface; use System.OS_Interface;
+with System.Task_Primitives.Operations; use System.Task_Primitives.Operations;
 
 with Interfaces.C; use Interfaces.C;
 
@@ -97,14 +98,18 @@ package body Ada.Execution_Time is
      (T : Ada.Task_Identification.Task_Id :=
         Ada.Task_Identification.Current_Task) return CPU_Time
    is
-      TS     : aliased timespec;
-      Result : Interfaces.C.int;
+      TS       : aliased timespec;
+      Clock_Id : aliased Interfaces.C.int;
+      Result   : Interfaces.C.int;
 
       function To_CPU_Time is
         new Ada.Unchecked_Conversion (Duration, CPU_Time);
       --  Time is equal to Duration (although it is a private type) and
       --  CPU_Time is equal to Time.
 
+      function Convert_Ids is new
+        Ada.Unchecked_Conversion (Task_Id, System.Tasking.Task_Id);
+
       function clock_gettime
         (clock_id : Interfaces.C.int;
          tp       : access timespec)
@@ -112,13 +117,26 @@ package body Ada.Execution_Time is
       pragma Import (C, clock_gettime, "clock_gettime");
       --  Function from the POSIX.1b Realtime Extensions library
 
+      function pthread_getcpuclockid
+        (tid       : Thread_Id;
+         clock_id  : access Interfaces.C.int)
+         return int;
+      pragma Import (C, pthread_getcpuclockid, "pthread_getcpuclockid");
+      --  Function from the Thread CPU-Time Clocks option
+
    begin
       if T = Ada.Task_Identification.Null_Task_Id then
          raise Program_Error;
+      else
+         --  Get the CPU clock for the task passed as parameter
+
+         Result := pthread_getcpuclockid
+           (Get_Thread_Id (Convert_Ids (T)), Clock_Id'Access);
+         pragma Assert (Result = 0);
       end if;
 
       Result := clock_gettime
-        (clock_id => CLOCK_THREAD_CPUTIME_ID, tp => TS'Unchecked_Access);
+        (clock_id => Clock_Id, tp => TS'Unchecked_Access);
       pragma Assert (Result = 0);
 
       return To_CPU_Time (To_Duration (TS));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index b27405f..201da87 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3945,7 +3945,7 @@ package Einfo is
 
 --    Rewritten_For_C (Flag287)
 --       Defined on functions that return a constrained array type, when
---       Modify_Tree_For_C is set. indicates that a procedure with an extra
+--       Modify_Tree_For_C is set. Indicates that a procedure with an extra
 --       out parameter has been created for it, and calls must be rewritten as
 --       calls to the new procedure.
 
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index f48d98d..539d088 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1135,20 +1135,23 @@ package System.Tasking is
       --  User-writeable location, for use in debugging tasks; also provides a
       --  simple task specific data.
 
+      Free_On_Termination : Boolean := False;
+      --  Deallocate the ATCB when the task terminates. This flag is normally
+      --  False, and is set True when Unchecked_Deallocation is called on a
+      --  non-terminated task so that the associated storage is automatically
+      --  reclaimed when the task terminates.
+
       Attributes : Attribute_Array := (others => 0);
       --  Task attributes
 
+      --  IMPORTANT Note: the Entry_Queues field is last for efficiency of
+      --  access to other fields, do not put new fields after this one.
+
       Entry_Queues : Task_Entry_Queue_Array (1 .. Entry_Num);
       --  An array of task entry queues
       --
       --  Protection: Self.L. Once a task has set Self.Stage to Completing, it
       --  has exclusive access to this field.
-
-      Free_On_Termination : Boolean := False;
-      --  Deallocate the ATCB when the task terminates. This flag is normally
-      --  False, and is set True when Unchecked_Deallocation is called on a
-      --  non-terminated task so that the associated storage is automatically
-      --  reclaimed when the task terminates.
    end record;
 
    --------------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 02e5ed3..d54ef0f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4728,7 +4728,12 @@ package body Sem_Ch13 is
                        Make_Raise_Program_Error (Loc,
                          Reason => PE_Overlaid_Controlled_Object));
 
-                  elsif Present (O_Ent)
+                  --  Issue an unconditional warning for a constant overlaying
+                  --  a variable. For the reverse case, we will issue it only
+                  --  if the variable is modified, see below.
+
+                  elsif Address_Clause_Overlay_Warnings
+                    and then Present (O_Ent)
                     and then Ekind (U_Ent) = E_Constant
                     and then not Is_Constant_Object (O_Ent)
                   then
@@ -4859,13 +4864,27 @@ package body Sem_Ch13 is
 
                      --  If variable overlays a constant view, and we are
                      --  warning on overlays, then mark the variable as
-                     --  overlaying a constant (we will give warnings later
-                     --  if this variable is assigned).
+                     --  overlaying a constant and warn immediately if it
+                     --  is initialized. We will give other warnings later
+                     --  if the variable is assigned.
 
                      if Is_Constant_Object (O_Ent)
                        and then Ekind (U_Ent) = E_Variable
                      then
-                        Set_Overlays_Constant (U_Ent);
+                        declare
+                           Init : constant Node_Id :=
+                             Expression (Declaration_Node (U_Ent));
+                        begin
+                           Set_Overlays_Constant (U_Ent);
+                           if Present (Init)
+                             and then Comes_From_Source (Init)
+                           then
+                              Error_Msg_Sloc := Sloc (N);
+                              Error_Msg_NE
+                                ("??constant& may be modified via address "
+                                 & "clause#", Declaration_Node (U_Ent), O_Ent);
+                           end if;
+                        end;
                      end if;
                   end if;
                end;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 6a3e5e7..af31c9f 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -619,6 +619,10 @@ package body Sem_Ch6 is
       R_Type : constant Entity_Id := Etype (Scope_Id);
       --  Function result subtype
 
+      procedure Check_Aggregate_Accessibility (Aggr : Node_Id);
+      --  Apply legality rule of 6.5 (8.2) to the access discriminants of
+      --  an aggregate in a return statement.
+
       procedure Check_Limited_Return (Expr : Node_Id);
       --  Check the appropriate (Ada 95 or Ada 2005) rules for returning
       --  limited types. Used only for simple return statements.
@@ -628,6 +632,57 @@ package body Sem_Ch6 is
       --  Check that the return_subtype_indication properly matches the result
       --  subtype of the function, as required by RM-6.5(5.1/2-5.3/2).
 
+      -----------------------------------
+      -- Check_Aggregate_Accessibility --
+      -----------------------------------
+
+      procedure Check_Aggregate_Accessibility (Aggr : Node_Id) is
+         Typ    : constant Entity_Id := Etype (Aggr);
+         Assoc  : Node_Id;
+         Discr  : Entity_Id;
+         Expr   : Node_Id;
+         Obj    : Node_Id;
+
+      begin
+         if Is_Record_Type (Typ)
+           and then Has_Discriminants (Typ)
+         then
+            Discr := First_Discriminant (Typ);
+            Assoc := First (Component_Associations (Aggr));
+            while Present (Discr) loop
+               if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
+                  Expr := Expression (Assoc);
+                  if Nkind (Expr) = N_Attribute_Reference
+                    and then Attribute_Name (Expr) /= Name_Unrestricted_Access
+                  then
+                     Obj := Prefix (Expr);
+                     while Nkind_In (Obj,
+                       N_Selected_Component, N_Indexed_Component)
+                     loop
+                        Obj := Prefix (Obj);
+                     end loop;
+
+                     if Is_Entity_Name (Obj)
+                       and then Is_Formal (Entity (Obj))
+                     then
+                        --  A run-time check may be needed ???
+                        null;
+
+                     elsif Object_Access_Level (Obj) >
+                       Scope_Depth (Scope (Scope_Id))
+                     then
+                        Error_Msg_N
+                           ("access discriminant in return aggregate " &
+                              "will be a dangling reference", Obj);
+                     end if;
+                  end if;
+               end if;
+
+               Next_Discriminant (Discr);
+            end loop;
+         end if;
+      end Check_Aggregate_Accessibility;
+
       --------------------------
       -- Check_Limited_Return --
       --------------------------
@@ -931,6 +986,10 @@ package body Sem_Ch6 is
 
             Resolve (Expr, R_Type);
             Check_Limited_Return (Expr);
+
+            if Present (Expr) and then Nkind (Expr) = N_Aggregate then
+               Check_Aggregate_Accessibility (Expr);
+            end if;
          end if;
 
          --  RETURN only allowed in SPARK as the last statement in function