2017-01-23 Gary Dismukes <dismukes@adacore.com>

	* exp_strm.ads: Minor reformatting and typo fixes.

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_aggr.adb, par_sco.adb, exp_util.adb, sem.adb, sem_ch4.adb,
	exp_aggr.adb: Minor reformatting.
	* g-diopit.adb: minor grammar/punctuation fix in comment.
	* g-byorma.ads: minor fix of unbalanced parens in comment.

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* par.adb: Update the documentation of component Labl.
	* par-ch6.adb (P_Return_Statement): Set the expected label of
	an extended return statement to Error.

2017-01-23  Tristan Gingold  <gingold@adacore.com>

	* s-boustr.ads, s-boustr.adb (Is_Full): New function.

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* expander.adb: Handle N_Delta_Aggregate.

2017-01-23  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Call): Improve the code that
	checks if some formal of the called subprogram is a class-wide
	interface, to handle subtypes of class-wide interfaces.

2017-01-23  Javier Miranda  <miranda@adacore.com>

	* checks.adb (Apply_Parameter_Aliasing_Checks):
	Remove side effects of the actuals before generating the overlap
	check.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@244806 138bc75d-0d04-0410-961f-82ee72b054a4

20 files changed, 221 insertions, 93 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 431885486a0..2ab1f234c55 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2017-01-23  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_strm.ads: Minor reformatting and typo fixes.
+
+2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_aggr.adb, par_sco.adb, exp_util.adb, sem.adb, sem_ch4.adb,
+	exp_aggr.adb: Minor reformatting.
+	* g-diopit.adb: minor grammar/punctuation fix in comment.
+	* g-byorma.ads: minor fix of unbalanced parens in comment.
+
+2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* par.adb: Update the documentation of component Labl.
+	* par-ch6.adb (P_Return_Statement): Set the expected label of
+	an extended return statement to Error.
+
+2017-01-23  Tristan Gingold  <gingold@adacore.com>
+
+	* s-boustr.ads, s-boustr.adb (Is_Full): New function.
+
+2017-01-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* expander.adb: Handle N_Delta_Aggregate.
+
+2017-01-23  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch6.adb (Expand_Call): Improve the code that
+	checks if some formal of the called subprogram is a class-wide
+	interface, to handle subtypes of class-wide interfaces.
+
+2017-01-23  Javier Miranda  <miranda@adacore.com>
+
+	* checks.adb (Apply_Parameter_Aliasing_Checks):
+	Remove side effects of the actuals before generating the overlap
+	check.
+
 2017-01-23  Justin Squirek  <squirek@adacore.com>
 
 	* exp_strm.ads, exp_strm.ads
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 011878eb046..f0ba9a8ad9e 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2360,6 +2360,9 @@ package body Checks is
                  and then not Is_Elementary_Type (Etype (Orig_Act_2))
                  and then May_Cause_Aliasing (Formal_1, Formal_2)
                then
+                  Remove_Side_Effects (Actual_1);
+                  Remove_Side_Effects (Actual_2);
+
                   Overlap_Check
                     (Actual_1 => Actual_1,
                      Actual_2 => Actual_2,
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index a41bfa08aed..6a0b0d53244 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6444,16 +6444,16 @@ package body Exp_Aggr is
    ------------------------------
 
    procedure Expand_N_Delta_Aggregate (N : Node_Id) is
-      Loc :  constant Source_Ptr := Sloc (N);
-      Temp : constant Entity_Id := Make_Temporary (Loc, 'T');
-      Typ  : constant Entity_Id := Etype (N);
+      Loc  : constant Source_Ptr := Sloc (N);
+      Typ  : constant Entity_Id  := Etype (N);
       Decl : Node_Id;
 
    begin
-      Decl := Make_Object_Declaration (Loc,
-         Defining_Identifier => Temp,
-         Object_Definition => New_Occurrence_Of (Typ, Loc),
-         Expression => New_Copy_Tree (Expression (N)));
+      Decl :=
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Make_Temporary (Loc, 'T'),
+          Object_Definition   => New_Occurrence_Of (Typ, Loc),
+          Expression          => New_Copy_Tree (Expression (N)));
 
       if Is_Array_Type (Etype (N)) then
          Expand_Delta_Array_Aggregate (N, New_List (Decl));
@@ -6467,15 +6467,19 @@ package body Exp_Aggr is
    ----------------------------------
 
    procedure Expand_Delta_Array_Aggregate (N : Node_Id; Deltas : List_Id) is
-      Loc    : constant Source_Ptr := Sloc (N);
-      Temp   : constant Entity_Id  := Defining_Identifier (First (Deltas));
-      Assoc  : Node_Id;
-      Choice : Node_Id;
+      Loc   : constant Source_Ptr := Sloc (N);
+      Temp  : constant Entity_Id  := Defining_Identifier (First (Deltas));
+      Assoc : Node_Id;
+
       function Generate_Loop (C : Node_Id) return Node_Id;
       --  Generate a loop containing individual component assignments for
       --  choices that are ranges, subtype indications, subtype names, and
       --  iterated component associations.
 
+      -------------------
+      -- Generate_Loop --
+      -------------------
+
       function Generate_Loop (C : Node_Id) return Node_Id is
          Sl : constant Source_Ptr := Sloc (C);
          Ix : Entity_Id;
@@ -6491,21 +6495,29 @@ package body Exp_Aggr is
 
          return
            Make_Loop_Statement (Loc,
-              Iteration_Scheme => Make_Iteration_Scheme (Sl,
-                Loop_Parameter_Specification =>
-                Make_Loop_Parameter_Specification (Sl,
-                  Defining_Identifier => Ix,
-                  Discrete_Subtype_Definition => New_Copy_Tree (C))),
-              End_Label => Empty,
-              Statements =>
-                New_List (
-                  Make_Assignment_Statement (Sl,
-                    Name       => Make_Indexed_Component (Sl,
+             Iteration_Scheme =>
+               Make_Iteration_Scheme (Sl,
+                 Loop_Parameter_Specification =>
+                   Make_Loop_Parameter_Specification (Sl,
+                     Defining_Identifier         => Ix,
+                     Discrete_Subtype_Definition => New_Copy_Tree (C))),
+
+              Statements      => New_List (
+                Make_Assignment_Statement (Sl,
+                  Name       =>
+                    Make_Indexed_Component (Sl,
                       Prefix      => New_Occurrence_Of (Temp, Sl),
                       Expressions => New_List (New_Occurrence_Of (Ix, Sl))),
-                    Expression => New_Copy_Tree (Expression (Assoc)))));
+                  Expression => New_Copy_Tree (Expression (Assoc)))),
+              End_Label       => Empty);
       end Generate_Loop;
 
+      --  Local variables
+
+      Choice : Node_Id;
+
+   --  Start of processing for Expand_Delta_Array_Aggregate
+
    begin
       Assoc := First (Component_Associations (N));
       while Present (Assoc) loop
@@ -6524,7 +6536,7 @@ package body Exp_Aggr is
 
                if Nkind (Choice) = N_Range
                  or else (Is_Entity_Name (Choice)
-                   and then Is_Type (Entity (Choice)))
+                           and then Is_Type (Entity (Choice)))
                then
                   Append_To (Deltas, Generate_Loop (Choice));
 
@@ -6534,11 +6546,12 @@ package body Exp_Aggr is
 
                else
                   Append_To (Deltas,
-                     Make_Assignment_Statement (Sloc (Choice),
-                       Name => Make_Indexed_Component (Sloc (Choice),
-                         Prefix => New_Occurrence_Of (Temp, Loc),
-                         Expressions => New_List (New_Copy_Tree (Choice))),
-                       Expression => New_Copy_Tree (Expression (Assoc))));
+                    Make_Assignment_Statement (Sloc (Choice),
+                      Name       =>
+                        Make_Indexed_Component (Sloc (Choice),
+                          Prefix      => New_Occurrence_Of (Temp, Loc),
+                          Expressions => New_List (New_Copy_Tree (Choice))),
+                      Expression => New_Copy_Tree (Expression (Assoc))));
                end if;
 
                Next (Choice);
@@ -6569,11 +6582,12 @@ package body Exp_Aggr is
          Choice := First (Choice_List (Assoc));
          while Present (Choice) loop
             Append_To (Deltas,
-               Make_Assignment_Statement (Sloc (Choice),
-                 Name => Make_Selected_Component (Sloc (Choice),
-                   Prefix => New_Occurrence_Of (Temp, Loc),
-                   Selector_Name => Make_Identifier (Loc, Chars (Choice))),
-                 Expression => New_Copy_Tree (Expression (Assoc))));
+              Make_Assignment_Statement (Sloc (Choice),
+                Name       =>
+                  Make_Selected_Component (Sloc (Choice),
+                    Prefix        => New_Occurrence_Of (Temp, Loc),
+                    Selector_Name => Make_Identifier (Loc, Chars (Choice))),
+                Expression => New_Copy_Tree (Expression (Assoc))));
             Next (Choice);
          end loop;
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a6579c28e39..e9f13319ed5 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2832,10 +2832,12 @@ package body Exp_Ch6 is
          CW_Interface_Formals_Present :=
            CW_Interface_Formals_Present
              or else
-               (Ekind (Etype (Formal)) = E_Class_Wide_Type
+               (Is_Class_Wide_Type (Etype (Formal))
                  and then Is_Interface (Etype (Etype (Formal))))
              or else
                (Ekind (Etype (Formal)) = E_Anonymous_Access_Type
+                 and then Is_Class_Wide_Type (Directly_Designated_Type
+                                               (Etype (Etype (Formal))))
                  and then Is_Interface (Directly_Designated_Type
                                          (Etype (Etype (Formal)))));
 
diff --git a/gcc/ada/exp_strm.ads b/gcc/ada/exp_strm.ads
index 397206c93fb..e3b859f1564 100644
--- a/gcc/ada/exp_strm.ads
+++ b/gcc/ada/exp_strm.ads
@@ -111,10 +111,10 @@ package Exp_Strm is
       Fnam           : out Entity_Id;
       Use_Underlying : Boolean := True);
    --  Build function for Input attribute for record type or for an elementary
-   --  type (the latter is used only in the case where a user defined Read
-   --  routine is defined, since in other cases, Input calls the appropriate
-   --  runtime library routine directly. The flag Use_Underlying controls
-   --  weither the base type or the underlying type of the base type of Typ is
+   --  type (the latter is used only in the case where a user-defined Read
+   --  routine is defined, since, in other cases, Input calls the appropriate
+   --  runtime library routine directly). The flag Use_Underlying controls
+   --  whether the base type or the underlying type of the base type of Typ is
    --  used during construction.
 
    procedure Build_Record_Or_Elementary_Output_Procedure
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3a1d98587c7..67a6c64a1d4 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -3783,8 +3783,8 @@ package body Exp_Util is
          --  Nothing to be done if no underlying record view available
 
          --  If this is a limited type derived from a type with unknown
-         --  discriminants, do not expand either, so that subsequent
-         --  expansion of the call can add build-in-place parameters to call.
+         --  discriminants, do not expand either, so that subsequent expansion
+         --  of the call can add build-in-place parameters to call.
 
          if No (Underlying_Record_View (Unc_Type))
            or else Is_Limited_Type (Unc_Type)
diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb
index 9045b6a72b7..23dd9197156 100644
--- a/gcc/ada/expander.adb
+++ b/gcc/ada/expander.adb
@@ -215,6 +215,9 @@ package body Expander is
                when N_Delay_Until_Statement =>
                   Expand_N_Delay_Until_Statement (N);
 
+               when N_Delta_Aggregate =>
+                  Expand_N_Delta_Aggregate (N);
+
                when N_Entry_Body =>
                   Expand_N_Entry_Body (N);
 
diff --git a/gcc/ada/g-byorma.ads b/gcc/ada/g-byorma.ads
index 46db6e475ea..a58006e6dcc 100644
--- a/gcc/ada/g-byorma.ads
+++ b/gcc/ada/g-byorma.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2006-2013, AdaCore                     --
+--                     Copyright (C) 2006-2016, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -32,7 +32,7 @@
 --  This package provides a procedure for reading and interpreting the BOM
 --  (byte order mark) used to publish the encoding method for a string (for
 --  example, a UTF-8 encoded file in windows will start with the appropriate
---  BOM sequence to signal UTF-8 encoding.
+--  BOM sequence to signal UTF-8 encoding).
 
 --  There are two cases
 
diff --git a/gcc/ada/g-diopit.adb b/gcc/ada/g-diopit.adb
index dabea22616f..65bd65c0229 100644
--- a/gcc/ada/g-diopit.adb
+++ b/gcc/ada/g-diopit.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2015, AdaCore                     --
+--                     Copyright (C) 2001-2016, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -140,9 +140,9 @@ package body GNAT.Directory_Operations.Iteration is
         (Directory      : String;
          File_Pattern   : String;
          Suffix_Pattern : String);
-      --  Read entries in Directory and call user's callback if the entry
-      --  match File_Pattern and Suffix_Pattern is empty otherwise it will go
-      --  down one more directory level by calling Next_Level routine above.
+      --  Read entries in Directory and call user's callback if the entry match
+      --  File_Pattern and Suffix_Pattern is empty; otherwise go down one more
+      --  directory level by calling Next_Level routine below.
 
       procedure Next_Level
         (Current_Path : String;
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 4dda2980c80..5c846645e9d 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -1898,6 +1898,11 @@ package body Ch3 is
                  ("aspect specifications must come after initialization "
                   & "expression",
                   Sloc (First (Aspect_Specifications (Decl_Node))));
+
+            else
+               --  In any case, the assignment symbol doesn't belong.
+
+               Error_Msg ("misplaced assignment symbol", Scan_Ptr);
             end if;
 
             Set_Expression (Decl_Node, Init_Expr_Opt);
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 73a0066c0a1..a1733d99bf1 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -1909,8 +1909,9 @@ package body Ch6 is
 
             if Token = Tok_Do then
                Push_Scope_Stack;
-               Scope.Table (Scope.Last).Etyp := E_Return;
                Scope.Table (Scope.Last).Ecol := Ret_Strt;
+               Scope.Table (Scope.Last).Etyp := E_Return;
+               Scope.Table (Scope.Last).Labl := Error;
                Scope.Table (Scope.Last).Sloc := Ret_Sloc;
 
                Scan; -- past DO
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 9b5c9c532a8..d3c069a04a9 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -476,8 +476,8 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  subprogram specifications and bodies the field holds the correponding
       --  program unit name. For task declarations and bodies, protected types
       --  and bodies, and accept statements the field hold the name of the type
-      --  or operation. For if-statements, case-statements, and selects, the
-      --  field is initialized to Error.
+      --  or operation. For if-statements, case-statements, return statements,
+      --  and selects, the field is initialized to Error.
 
       --  Note: this is a bit of an odd (mis)use of Error, since there is no
       --  Error, but we use this value as a place holder to indicate that it
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index ceed72c8c10..3747605a29e 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -1431,9 +1431,9 @@ package body Par_SCO is
       --  Record first entries used in SC/SD at this recursive level
 
       procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
-      --  Extend the current statement sequence to encompass the node N. Typ
-      --  is the letter that identifies the type of statement/declaration that
-      --  is being added to the sequence.
+      --  Extend the current statement sequence to encompass the node N. Typ is
+      --  the letter that identifies the type of statement/declaration that is
+      --  being added to the sequence.
 
       procedure Process_Decisions_Defer (N : Node_Id; T : Character);
       pragma Inline (Process_Decisions_Defer);
@@ -1461,8 +1461,8 @@ package body Par_SCO is
       --  Helper for Traverse_One: traverse N's aspect specifications
 
       procedure Traverse_Degenerate_Subprogram (N : Node_Id);
-      --  Common code to handle null procedures and expression functions.
-      --  Emit a SCO of the given Kind and N outside of the dominance flow.
+      --  Common code to handle null procedures and expression functions. Emit
+      --  a SCO of the given Kind and N outside of the dominance flow.
 
       -------------------------------
       -- Extend_Statement_Sequence --
@@ -1745,9 +1745,9 @@ package body Par_SCO is
             --  Save last statement in current sequence as dominant
 
          begin
-            --  Output statement SCO for degenerate subprogram body
-            --  (null statement or freestanding expression) outside of
-            --  the dominance chain.
+            --  Output statement SCO for degenerate subprogram body (null
+            --  statement or freestanding expression) outside of the dominance
+            --  chain.
 
             Current_Dominant := No_Dominant;
             Extend_Statement_Sequence (N, Typ => ' ');
@@ -1758,11 +1758,12 @@ package body Par_SCO is
             if Nkind (N) in N_Subexpr then
                Process_Decisions_Defer (N, 'X');
             end if;
+
             Set_Statement_Entry;
 
-            --  Restore current dominant information designating last
-            --  statement in previous sequence (i.e. make the dominance
-            --  chain skip over the degenerate body).
+            --  Restore current dominant information designating last statement
+            --  in previous sequence (i.e. make the dominance chain skip over
+            --  the degenerate body).
 
             Current_Dominant := Saved_Dominant;
          end;
@@ -1801,9 +1802,9 @@ package body Par_SCO is
 
             --  Subprogram declaration or subprogram body stub
 
-            when N_Subprogram_Body_Stub
+            when N_Expression_Function
+               | N_Subprogram_Body_Stub
                | N_Subprogram_Declaration
-               | N_Expression_Function
             =>
                declare
                   Spec : constant Node_Id := Specification (N);
@@ -1819,9 +1820,9 @@ package body Par_SCO is
                   then
                      Traverse_Degenerate_Subprogram (N);
 
-                  --  Case of an expression function: generate a statement
-                  --  SCO for the expression (and then decision SCOs for any
-                  --  nested decisions).
+                  --  Case of an expression function: generate a statement SCO
+                  --  for the expression (and then decision SCOs for any nested
+                  --  decisions).
 
                   elsif Nkind (N) = N_Expression_Function then
                      Traverse_Degenerate_Subprogram (Expression (N));
diff --git a/gcc/ada/s-boustr.adb b/gcc/ada/s-boustr.adb
index ca07dbb0932..1eb168d95a8 100644
--- a/gcc/ada/s-boustr.adb
+++ b/gcc/ada/s-boustr.adb
@@ -83,6 +83,15 @@ package body System.Bounded_Strings is
       Append (X, S (P - 1 .. S'Last));
    end Append_Address;
 
+   -------------
+   -- Is_Full --
+   -------------
+
+   function Is_Full (X : Bounded_String) return Boolean is
+   begin
+      return X.Length >= X.Max_Length;
+   end Is_Full;
+
    ---------------
    -- To_String --
    ---------------
diff --git a/gcc/ada/s-boustr.ads b/gcc/ada/s-boustr.ads
index 6e81a49506c..0cc2ccec8b4 100644
--- a/gcc/ada/s-boustr.ads
+++ b/gcc/ada/s-boustr.ads
@@ -48,6 +48,9 @@ package System.Bounded_Strings is
    procedure Append_Address (X : in out Bounded_String; A : Address);
    --  Append an address to X
 
+   function Is_Full (X : Bounded_String) return Boolean;
+   --  Return True iff X is full and any character or string will be dropped
+   --  if appended.
 private
    type Bounded_String (Max_Length : Natural) is limited record
       Length : Natural := 0;
diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads
index 2bcf56e500d..ee1809e2ec1 100644
--- a/gcc/ada/s-osinte-linux.ads
+++ b/gcc/ada/s-osinte-linux.ads
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2016, 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- --
@@ -270,6 +270,7 @@ package System.OS_Interface is
    pragma Import (C, getpid, "getpid");
 
    PR_SET_NAME : constant := 15;
+   PR_GET_NAME : constant := 16;
 
    function prctl
      (option                 : int;
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 85990f6dfb6..ad603d8e58d 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -755,14 +755,55 @@ package body System.Task_Primitives.Operations is
       Self_ID.Common.LL.Thread := pthread_self;
       Self_ID.Common.LL.LWP := lwp_self;
 
-      if Self_ID.Common.Task_Image_Len > 0 then
+      --  Set thread name to ease debugging. If the name of the task is
+      --  "foreign thread" (as set by Register_Foreign_Thread) retrieve
+      --  the name of the thread and update the name of the task instead.
+
+      if Self_ID.Common.Task_Image_Len = 14
+        and then Self_ID.Common.Task_Image (1 .. 14) = "foreign thread"
+      then
+         declare
+            Thread_Name : String (1 .. 16);
+            --  PR_GET_NAME returns a string of up to 16 bytes
+
+            Len    : Natural := 0;
+            --  Length of the task name contained in Task_Name
+
+            Result : int;
+            --  Result from the prctl call
+         begin
+            Result := prctl (PR_GET_NAME, unsigned_long (Thread_Name'Address));
+            pragma Assert (Result = 0);
+
+            --  Find the length of the given name
+
+            for J in Thread_Name'Range loop
+               if Thread_Name (J) /= ASCII.NUL then
+                  Len := Len + 1;
+               else
+                  exit;
+               end if;
+            end loop;
+
+            --  Cover the odd situtation if someone decides to change
+            --  Parameters.Max_Task_Image_Length to less than 16 characters
+
+            if Len > Parameters.Max_Task_Image_Length then
+               Len := Parameters.Max_Task_Image_Length;
+            end if;
+
+            --  Copy the name of the thread to the task's ATCB
+
+            Self_ID.Common.Task_Image (1 .. Len) := Thread_Name (1 .. Len);
+            Self_ID.Common.Task_Image_Len := Len;
+         end;
+
+      elsif Self_ID.Common.Task_Image_Len > 0 then
          declare
             Task_Name : String (1 .. Parameters.Max_Task_Image_Length + 1);
             Result    : int;
 
          begin
-            --  Set thread name to ease debugging
-
             Task_Name (1 .. Self_ID.Common.Task_Image_Len) :=
               Self_ID.Common.Task_Image (1 .. Self_ID.Common.Task_Image_Len);
             Task_Name (Self_ID.Common.Task_Image_Len + 1) := ASCII.NUL;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index bae89ad5ad1..9b7c4903974 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -196,12 +196,12 @@ package body Sem is
          when N_Delay_Relative_Statement =>
             Analyze_Delay_Relative (N);
 
-         when N_Delta_Aggregate =>
-            Analyze_Aggregate (N);
-
          when N_Delay_Until_Statement =>
             Analyze_Delay_Until (N);
 
+         when N_Delta_Aggregate =>
+            Analyze_Aggregate (N);
+
          when N_Entry_Body =>
             Analyze_Entry_Body (N);
 
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 65d586da32a..efa5d60b6af 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -2740,12 +2740,8 @@ package body Sem_Aggr is
    -----------------------------
 
    procedure Resolve_Delta_Aggregate (N : Node_Id; Typ : Entity_Id) is
-      Base       : constant Node_Id   := Expression (N);
-      Deltas     : constant List_Id   := Component_Associations (N);
-      Assoc      : Node_Id;
-      Choice     : Node_Id;
-      Comp_Type  : Entity_Id;
-      Index_Type : Entity_Id;
+      Base   : constant Node_Id := Expression (N);
+      Deltas : constant List_Id := Component_Associations (N);
 
       function Get_Component_Type (Nam : Node_Id) return Entity_Id;
 
@@ -2775,12 +2771,22 @@ package body Sem_Aggr is
          return Any_Type;
       end Get_Component_Type;
 
+      --  Local variables
+
+      Assoc      : Node_Id;
+      Choice     : Node_Id;
+      Comp_Type  : Entity_Id;
+      Index_Type : Entity_Id;
+
+   --  Start of processing for Resolve_Delta_Aggregate
+
    begin
       if not Is_Composite_Type (Typ) then
          Error_Msg_N ("not a composite type", N);
       end if;
 
       Analyze_And_Resolve (Base, Typ);
+
       if Is_Array_Type (Typ) then
          Index_Type := Etype (First_Index (Typ));
          Assoc := First (Deltas);
@@ -2800,10 +2806,10 @@ package body Sem_Aggr is
                end loop;
 
                declare
-                  Id  : constant Entity_Id  := Defining_Identifier (Assoc);
-                  Ent : constant Entity_Id  :=
-                    New_Internal_Entity
-                      (E_Loop, Current_Scope, Sloc (Assoc), 'L');
+                  Id  : constant Entity_Id := Defining_Identifier (Assoc);
+                  Ent : constant Entity_Id :=
+                          New_Internal_Entity
+                            (E_Loop, Current_Scope, Sloc (Assoc), 'L');
 
                begin
                   Set_Etype  (Ent, Standard_Void_Type);
@@ -2838,8 +2844,9 @@ package body Sem_Aggr is
                         if Base_Type (Entity (Choice)) /=
                            Base_Type (Index_Type)
                         then
-                           Error_Msg_NE ("choice does mat match index type of",
-                             Choice, Typ);
+                           Error_Msg_NE
+                             ("choice does mat match index type of",
+                              Choice, Typ);
                         end if;
                      else
                         Resolve (Choice, Index_Type);
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 7a2666144b9..ef4206b9b30 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -9287,19 +9287,20 @@ package body Sem_Ch4 is
                Typ := Corresponding_Record_Type (Typ);
             end if;
 
-            --  Simple case. Object may be a subtype of the tagged type or
-            --  may be the corresponding record of a synchronized type.
+            --  Simple case. Object may be a subtype of the tagged type or may
+            --  be the corresponding record of a synchronized type.
 
             return Obj_Type = Typ
               or else Base_Type (Obj_Type) = Typ
               or else Corr_Type = Typ
 
               --  Object may be of a derived type whose parent has unknown
-              --  discriminants, in which case the type matches the
-              --  underlying record view of its base.
+              --  discriminants, in which case the type matches the underlying
+              --  record view of its base.
 
-              or else (Has_Unknown_Discriminants (Typ)
-                and then Typ = Underlying_Record_View (Base_Type (Obj_Type)))
+              or else
+                (Has_Unknown_Discriminants (Typ)
+                  and then Typ = Underlying_Record_View (Base_Type (Obj_Type)))
 
                --  Prefix can be dereferenced
 
@@ -9307,8 +9308,8 @@ package body Sem_Ch4 is
                 (Is_Access_Type (Corr_Type)
                   and then Designated_Type (Corr_Type) = Typ)
 
-               --  Formal is an access parameter, for which the object
-               --  can provide an access.
+               --  Formal is an access parameter, for which the object can
+               --  provide an access.
 
               or else
                 (Ekind (Typ) = E_Anonymous_Access_Type