[multiple changes]

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* sinfo.adb, sinfo.ads, sem_prag.adb, sem_ch12.adb (Pragma_Enabled):
	This flag of N_Pragma nodes is not used, remove it as well as all of
	the associated circuitry.

2011-08-04  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_DT): Switch -gnatdQ disables the generation of the
	runtime check on duplicated externa tags
	* debug.adb Document switch -gnatdQ.

2011-08-04  Gary Dismukes  <dismukes@adacore.com>

	* a-fihema.ads: Minor typo fix.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_ch10.adb: Minor comment update.

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Update the node field usage to reflect the renaming of
	Return_Flag to Return_ Flag_Or_Transient_Decl.
	(Return_Flag): Renamed to Return_Flag_Or_Transient_Decl.
	(Set_Return_Flag): Renamed to Set_Return_Flag_Or_Transient_Decl.
	(Write_Field15_Name): Change Return_Flag to
	Return_Flag_Or_Transient_Decl.
	* einfo.ads: Rename node field Return_Flag to
	Return_Flag_Or_Transient_Decl. Update the associated comment and all
	occurrences in entities.
	(Return_Flag): Renamed to Return_Flag_Or_Transient_Decl. Update
	associated Inline pragma.
	(Set_Return_Flag): Renamed to Set_Return_Flag_Or_Transient_Decl. Update
	associated Inline pragma.
	* exp_ch4.ads, exp_ch4.adb (Expand_N_Expression_With_Actions): New
	routine.
	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Update the calls to
	Return_Flag and Set_Return_Flag.
	* exp_ch7.adb (Process_Declarations): Add code to recognize hook
	objects generated for controlled transients declared inside an
	Exception_With_Actions. Update the calls to Return_Flag.
	(Process_Object_Declaration): Add code to add a null guard for hook
	objects generated for controlled transients declared inside an
	Exception_With_Actions. Update related comment.
	* exp_util.adb (Has_Controlled_Objects): Add code to recognize hook
	objects generated for controlled transients declared inside an
	Exception_With_Actions. Update the calls to Return_Flag.
	* expander.adb (Expand): Add new case for N_Expression_With_Actions.

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb:(Wrong_Type): Improve error message on a one-element
	positional aggregate.

2011-08-04  Vincent Celier  <celier@adacore.com>

	* par_sco.adb (Process_Decisions.Output_Header): Check and record pragma
	SLOC only for pragmas.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* projects.texi: Minor typo fix.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* prj-nmsc.adb (Check_File): Minor change to traces, to help debugging
	on case-sensitive file systems.

From-SVN: r177349

21 files changed, 346 insertions, 101 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 402aec6..b90a4ac 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,74 @@
 2011-08-04  Thomas Quinot  <quinot@adacore.com>
 
+	* sinfo.adb, sinfo.ads, sem_prag.adb, sem_ch12.adb (Pragma_Enabled):
+	This flag of N_Pragma nodes is not used, remove it as well as all of
+	the associated circuitry.
+
+2011-08-04  Javier Miranda  <miranda@adacore.com>
+
+	* exp_disp.adb (Make_DT): Switch -gnatdQ disables the generation of the
+	runtime check on duplicated externa tags
+	* debug.adb Document switch -gnatdQ.
+
+2011-08-04  Gary Dismukes  <dismukes@adacore.com>
+
+	* a-fihema.ads: Minor typo fix.
+
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch10.adb: Minor comment update.
+
+2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* einfo.adb: Update the node field usage to reflect the renaming of
+	Return_Flag to Return_ Flag_Or_Transient_Decl.
+	(Return_Flag): Renamed to Return_Flag_Or_Transient_Decl.
+	(Set_Return_Flag): Renamed to Set_Return_Flag_Or_Transient_Decl.
+	(Write_Field15_Name): Change Return_Flag to
+	Return_Flag_Or_Transient_Decl.
+	* einfo.ads: Rename node field Return_Flag to
+	Return_Flag_Or_Transient_Decl. Update the associated comment and all
+	occurrences in entities.
+	(Return_Flag): Renamed to Return_Flag_Or_Transient_Decl. Update
+	associated Inline pragma.
+	(Set_Return_Flag): Renamed to Set_Return_Flag_Or_Transient_Decl. Update
+	associated Inline pragma.
+	* exp_ch4.ads, exp_ch4.adb (Expand_N_Expression_With_Actions): New
+	routine.
+	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Update the calls to
+	Return_Flag and Set_Return_Flag.
+	* exp_ch7.adb (Process_Declarations): Add code to recognize hook
+	objects generated for controlled transients declared inside an
+	Exception_With_Actions. Update the calls to Return_Flag.
+	(Process_Object_Declaration): Add code to add a null guard for hook
+	objects generated for controlled transients declared inside an
+	Exception_With_Actions. Update related comment.
+	* exp_util.adb (Has_Controlled_Objects): Add code to recognize hook
+	objects generated for controlled transients declared inside an
+	Exception_With_Actions. Update the calls to Return_Flag.
+	* expander.adb (Expand): Add new case for N_Expression_With_Actions.
+
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb:(Wrong_Type): Improve error message on a one-element
+	positional aggregate.
+
+2011-08-04  Vincent Celier  <celier@adacore.com>
+
+	* par_sco.adb (Process_Decisions.Output_Header): Check and record pragma
+	SLOC only for pragmas.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* projects.texi: Minor typo fix.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-nmsc.adb (Check_File): Minor change to traces, to help debugging
+	on case-sensitive file systems.
+
+2011-08-04  Thomas Quinot  <quinot@adacore.com>
+
 	* put_scos.adb (Put_SCOs): Do not emit decision SCO for an X decision
 	nested in a disabled pragma.
 	* scos.ads, scos.adb, par_sco.ads, par_sco.adb: Record sloc of
diff --git a/gcc/ada/a-fihema.ads b/gcc/ada/a-fihema.ads
index 028d771..df0afa2 100644
--- a/gcc/ada/a-fihema.ads
+++ b/gcc/ada/a-fihema.ads
@@ -133,7 +133,7 @@ private
 
       Finalize_Address : Finalize_Address_Ptr;
       --  A reference to a routine which finalizes an object denoted by its
-      --  address. The collection must be homogenious since the same routine
+      --  address. The collection must be homogeneous since the same routine
       --  will be invoked for every allocated object when the pool is
       --  finalized.
 
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 65af4de..35d1ced 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -80,7 +80,7 @@ package body Debug is
    --  dN   No file name information in exception messages
    --  dO   Output immediate error messages
    --  dP   Do not check for controlled objects in preelaborable packages
-   --  dQ
+   --  dQ   Do not generate runtime check for duplicated external tag
    --  dR   Bypass check for correct version of s-rpc
    --  dS   Never convert numbers to machine numbers in Sem_Eval
    --  dT   Convert to machine numbers only for constant declarations
@@ -428,6 +428,12 @@ package body Debug is
    --       in preelaborable packages, but this restriction is a huge pain,
    --       especially in the predefined library units.
 
+   --  dQ   Eliminate check for duplicate external tags. This check was added
+   --       for GNAT 6.4.1, and causes some backward compatibility problems.
+   --       It is never legitimate to have duplicate external tags, so the
+   --       check is certainly valid, but this debug switch can be useful for
+   --       enabling previous behavior of ignoring this problem.
+
    --  dR   Bypass the check for a proper version of s-rpc being present
    --       to use the -gnatz? switch. This allows debugging of the use
    --       of stubs generation without needing to have GLADE (or some
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 84163c6..f0f0904 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -123,7 +123,7 @@ package body Einfo is
    --    Extra_Formal                    Node15
    --    Lit_Indexes                     Node15
    --    Related_Instance                Node15
-   --    Return_Flag                     Node15
+   --    Return_Flag_Or_Transient_Decl   Node15
    --    Scale_Value                     Uint15
    --    Storage_Size_Variable           Node15
    --    String_Literal_Low_Bound        Node15
@@ -2559,11 +2559,11 @@ package body Einfo is
       return Flag213 (Id);
    end Requires_Overriding;
 
-   function Return_Flag (Id : E) return N is
+   function Return_Flag_Or_Transient_Decl (Id : E) return N is
    begin
       pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
       return Node15 (Id);
-   end Return_Flag;
+   end Return_Flag_Or_Transient_Decl;
 
    function Return_Present (Id : E) return B is
    begin
@@ -5101,11 +5101,11 @@ package body Einfo is
       Set_Flag213 (Id, V);
    end Set_Requires_Overriding;
 
-   procedure Set_Return_Flag (Id : E; V : E) is
+   procedure Set_Return_Flag_Or_Transient_Decl (Id : E; V : E) is
    begin
       pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
       Set_Node15 (Id, V);
-   end Set_Return_Flag;
+   end Set_Return_Flag_Or_Transient_Decl;
 
    procedure Set_Return_Present (Id : E; V : B := True) is
    begin
@@ -8130,7 +8130,7 @@ package body Einfo is
 
          when E_Constant                                   |
               E_Variable                                   =>
-            Write_Str ("Return_Flag");
+            Write_Str ("Return_Flag_Or_Transient_Decl");
 
          when Decimal_Fixed_Point_Kind                     =>
             Write_Str ("Scale_Value");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 49e22fb..23d3c3b 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3494,11 +3494,14 @@ package Einfo is
 --       is True only for implicitly declare subprograms; it is not set on the
 --       parent type's subprogram. See also Is_Abstract_Subprogram.
 
---    Return_Flag (Node15)
+--    Return_Flag_Or_Transient_Decl (Node15)
 --       Applies to variables and constants. Set for objects which act as the
 --       return value of an extended return statement. The node contains the
 --       entity of a locally declared flag which controls the finalization of
---       the return object should the function fail.
+--       the return object should the function fail. Also set for access-to-
+--       controlled objects used to provide a hook to controlled transients
+--       declared inside an Expression_With_Actions. The node contains the
+--       object declaration of the controlled transient.
 
 --    Return_Present (Flag54)
 --       Present in function and generic function entities. Set if the
@@ -5064,7 +5067,7 @@ package Einfo is
    --    Full_View                           (Node11)
    --    Esize                               (Uint12)
    --    Alignment                           (Uint14)
-   --    Return_Flag                         (Node15)   (constants only)
+   --    Return_Flag_Or_Transient_Decl       (Node15)   (constants only)
    --    Actual_Subtype                      (Node17)
    --    Renamed_Object                      (Node18)
    --    Size_Check_Code                     (Node19)   (constants only)
@@ -5710,7 +5713,7 @@ package Einfo is
    --    Esize                               (Uint12)
    --    Extra_Accessibility                 (Node13)
    --    Alignment                           (Uint14)
-   --    Return_Flag                         (Node15)   (transient object only)
+   --    Return_Flag_Or_Transient_Decl       (Node15)   (transient object only)
    --    Unset_Reference                     (Node16)
    --    Actual_Subtype                      (Node17)
    --    Renamed_Object                      (Node18)
@@ -6328,7 +6331,7 @@ package Einfo is
    function Renamed_Object                      (Id : E) return N;
    function Renaming_Map                        (Id : E) return U;
    function Requires_Overriding                 (Id : E) return B;
-   function Return_Flag                         (Id : E) return E;
+   function Return_Flag_Or_Transient_Decl       (Id : E) return E;
    function Return_Present                      (Id : E) return B;
    function Return_Applies_To                   (Id : E) return N;
    function Returns_By_Ref                      (Id : E) return B;
@@ -6924,7 +6927,7 @@ package Einfo is
    procedure Set_Renamed_Object                  (Id : E; V : N);
    procedure Set_Renaming_Map                    (Id : E; V : U);
    procedure Set_Requires_Overriding             (Id : E; V : B := True);
-   procedure Set_Return_Flag                     (Id : E; V : E);
+   procedure Set_Return_Flag_Or_Transient_Decl   (Id : E; V : E);
    procedure Set_Return_Present                  (Id : E; V : B := True);
    procedure Set_Return_Applies_To               (Id : E; V : N);
    procedure Set_Returns_By_Ref                  (Id : E; V : B := True);
@@ -7663,7 +7666,7 @@ package Einfo is
    pragma Inline (Renamed_Object);
    pragma Inline (Renaming_Map);
    pragma Inline (Requires_Overriding);
-   pragma Inline (Return_Flag);
+   pragma Inline (Return_Flag_Or_Transient_Decl);
    pragma Inline (Return_Present);
    pragma Inline (Return_Applies_To);
    pragma Inline (Returns_By_Ref);
@@ -8063,7 +8066,7 @@ package Einfo is
    pragma Inline (Set_Renamed_Object);
    pragma Inline (Set_Renaming_Map);
    pragma Inline (Set_Requires_Overriding);
-   pragma Inline (Set_Return_Flag);
+   pragma Inline (Set_Return_Flag_Or_Transient_Decl);
    pragma Inline (Set_Return_Present);
    pragma Inline (Set_Return_Applies_To);
    pragma Inline (Set_Returns_By_Ref);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 2444e60..afe0c06 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4302,6 +4302,126 @@ package body Exp_Ch4 is
       Insert_Dereference_Action (Prefix (N));
    end Expand_N_Explicit_Dereference;
 
+   --------------------------------------
+   -- Expand_N_Expression_With_Actions --
+   --------------------------------------
+
+   procedure Expand_N_Expression_With_Actions (N : Node_Id) is
+
+      procedure Process_Transient_Object (Decl : Node_Id);
+      --  Given the declaration of a controlled transient declared inside the
+      --  Actions list of an Expression_With_Actions, generate all necessary
+      --  types and hooks in order to properly finalize the transient. This
+      --  mechanism works in conjunction with Build_Finalizer.
+
+      ------------------------------
+      -- Process_Transient_Object --
+      ------------------------------
+
+      procedure Process_Transient_Object (Decl : Node_Id) is
+         Ins_Nod   : constant Node_Id    := Parent (N);
+         --  To avoid the insertion of generated code in the list of Actions,
+         --  Insert_Action must look at the parent field of the EWA.
+
+         Loc       : constant Source_Ptr := Sloc (Decl);
+         Obj_Id    : constant Entity_Id  := Defining_Identifier (Decl);
+         Obj_Typ   : constant Entity_Id  := Etype (Obj_Id);
+         Desig_Typ : Entity_Id;
+         Expr      : Node_Id;
+         Ptr_Decl  : Node_Id;
+         Ptr_Id    : Entity_Id;
+         Temp_Decl : Node_Id;
+         Temp_Id   : Node_Id;
+
+      begin
+         --  Step 1: Create the access type which provides a reference to
+         --  the transient object.
+
+         if Is_Access_Type (Obj_Typ) then
+            Desig_Typ := Directly_Designated_Type (Obj_Typ);
+         else
+            Desig_Typ := Obj_Typ;
+         end if;
+
+         --  Generate:
+         --    Ann : access [all] <Desig_Typ>;
+
+         Ptr_Id := Make_Temporary (Loc, 'A');
+
+         Ptr_Decl :=
+           Make_Full_Type_Declaration (Loc,
+             Defining_Identifier => Ptr_Id,
+               Type_Definition =>
+                 Make_Access_To_Object_Definition (Loc,
+                   All_Present =>
+                     Ekind (Obj_Typ) = E_General_Access_Type,
+                   Subtype_Indication =>
+                     New_Reference_To (Desig_Typ, Loc)));
+
+         Insert_Action (Ins_Nod, Ptr_Decl);
+         Analyze (Ptr_Decl);
+
+         --  Step 2: Create a temporary which acts as a hook to the transient
+         --  object. Generate:
+
+         --    Temp : Ptr_Id := null;
+
+         Temp_Id := Make_Temporary (Loc, 'T');
+
+         Temp_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Temp_Id,
+             Object_Definition   => New_Reference_To (Ptr_Id, Loc));
+
+         Insert_Action (Ins_Nod, Temp_Decl);
+         Analyze (Temp_Decl);
+
+         --  Mark this temporary as created for the purposes of "exporting" the
+         --  transient declaration out of the Actions list. This signals the
+         --  machinery in Build_Finalizer to recognize this special case.
+
+         Set_Return_Flag_Or_Transient_Decl (Temp_Id, Decl);
+
+         --  Step 3: "Hook" the transient object to the temporary
+
+         if Is_Access_Type (Obj_Typ) then
+            Expr := Convert_To (Ptr_Id, New_Reference_To (Obj_Id, Loc));
+         else
+            Expr :=
+              Make_Attribute_Reference (Loc,
+                Prefix =>
+                  New_Reference_To (Obj_Id, Loc),
+                Attribute_Name => Name_Unrestricted_Access);
+         end if;
+
+         --  Generate:
+         --    Temp := Ptr_Id (Obj_Id);
+         --      <or>
+         --    Temp := Obj_Id'Unrestricted_Access;
+
+         Insert_After_And_Analyze (Decl,
+           Make_Assignment_Statement (Loc,
+             Name       => New_Reference_To (Temp_Id, Loc),
+             Expression => Expr));
+      end Process_Transient_Object;
+
+      Decl : Node_Id;
+
+   --  Start of processing for Expand_N_Expression_With_Actions
+
+   begin
+      Decl := First (Actions (N));
+      while Present (Decl) loop
+         if Nkind (Decl) = N_Object_Declaration
+           and then Is_Finalizable_Transient (Decl, N)
+         then
+            Process_Transient_Object (Decl);
+         end if;
+
+         Next (Decl);
+      end loop;
+   end Expand_N_Expression_With_Actions;
+
    -----------------
    -- Expand_N_In --
    -----------------
diff --git a/gcc/ada/exp_ch4.ads b/gcc/ada/exp_ch4.ads
index 8043658..17323f2 100644
--- a/gcc/ada/exp_ch4.ads
+++ b/gcc/ada/exp_ch4.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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,6 +34,7 @@ package Exp_Ch4 is
    procedure Expand_N_Case_Expression             (N : Node_Id);
    procedure Expand_N_Conditional_Expression      (N : Node_Id);
    procedure Expand_N_Explicit_Dereference        (N : Node_Id);
+   procedure Expand_N_Expression_With_Actions     (N : Node_Id);
    procedure Expand_N_In                          (N : Node_Id);
    procedure Expand_N_Indexed_Component           (N : Node_Id);
    procedure Expand_N_Not_In                      (N : Node_Id);
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index ca449fa..9fda91c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4649,7 +4649,7 @@ package body Exp_Ch6 is
             --  Create a flag to track the function state
 
             Flag_Id := Make_Temporary (Loc, 'F');
-            Set_Return_Flag (Ret_Obj_Id, Flag_Id);
+            Set_Return_Flag_Or_Transient_Decl (Ret_Obj_Id, Flag_Id);
 
             --  Insert the flag at the beginning of the function declarations,
             --  generate:
@@ -4713,8 +4713,8 @@ package body Exp_Ch6 is
            and then Needs_Finalization (Etype (Ret_Obj_Id))
          then
             declare
-               Flag_Id : constant Entity_Id := Return_Flag (Ret_Obj_Id);
-
+               Flag_Id : constant Entity_Id :=
+                           Return_Flag_Or_Transient_Decl (Ret_Obj_Id);
             begin
                --  Generate:
                --    Fnn := True;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index f79520e..5443691 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1785,6 +1785,15 @@ package body Exp_Ch7 is
                then
                   Processing_Actions (Has_No_Init => True);
 
+               elsif Is_Access_Type (Obj_Typ)
+                 and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
+                 and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
+                                   N_Object_Declaration
+                 and then Is_Finalizable_Transient
+                            (Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
+               then
+                  Processing_Actions (Has_No_Init => True);
+
                --  Simple protected objects which use type System.Tasking.
                --  Protected_Objects.Protection to manage their locks should
                --  be treated as controlled since they require manual cleanup.
@@ -1850,7 +1859,7 @@ package body Exp_Ch7 is
 
                elsif Needs_Finalization (Obj_Typ)
                  and then Is_Return_Object (Obj_Id)
-                 and then Present (Return_Flag (Obj_Id))
+                 and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
                then
                   Processing_Actions (Has_No_Init => True);
                end if;
@@ -2517,25 +2526,69 @@ package body Exp_Ch7 is
                end;
             end if;
 
-            --  Return objects use a flag to aid their potential finalization
-            --  then the enclosing function fails to return properly. Generate:
-            --
-            --    if not Flag then
-            --       <object finalization statements>
-            --    end if;
-
             if Ekind_In (Obj_Id, E_Constant, E_Variable)
-              and then Is_Return_Object (Obj_Id)
-              and then Present (Return_Flag (Obj_Id))
+              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
             then
-               Fin_Stmts := New_List (
-                 Make_If_Statement (Loc,
-                   Condition     =>
-                     Make_Op_Not (Loc,
-                       Right_Opnd =>
-                         New_Reference_To (Return_Flag (Obj_Id), Loc)),
+               --  Return objects use a flag to aid their potential
+               --  finalization when the enclosing function fails to return
+               --  properly. Generate:
+               --
+               --    if not Flag then
+               --       <object finalization statements>
+               --    end if;
+
+               if Is_Return_Object (Obj_Id) then
+                  Fin_Stmts := New_List (
+                    Make_If_Statement (Loc,
+                      Condition     =>
+                        Make_Op_Not (Loc,
+                          Right_Opnd =>
+                            New_Reference_To
+                              (Return_Flag_Or_Transient_Decl (Obj_Id), Loc)),
+
+                    Then_Statements => Fin_Stmts));
+
+               --  Temporaries created for the purpose of "exporting" a
+               --  controlled transient out of an Expression_With_Actions (EWA)
+               --  need guards. The following illustrates the usage of such
+               --  temporaries.
+
+               --    Access_Typ : access [all] Obj_Typ;
+               --    Temp       : Access_Typ := null;
+               --    <Counter>  := ...;
+
+               --    do
+               --       Ctrl_Trans : [access [all]] Obj_Typ := ...;
+               --       Temp := Access_Typ (Ctrl_Trans);  --  when a pointer
+               --         <or>
+               --       Temp := Ctrl_Trans'Unchecked_Access;
+               --    in ... end;
+
+               --  The finalization machinery does not process EWA nodes as
+               --  this may lead to premature finalization of expressions. Note
+               --  that Temp is marked as being properly initialized regardless
+               --  of whether the initialization of Ctrl_Trans succeeded. Since
+               --  a failed initialization may leave Temp with a value of null,
+               --  add a guard to handle this case:
+
+               --    if Obj /= null then
+               --       <object finalization statements>
+               --    end if;
 
-                 Then_Statements => Fin_Stmts));
+               else
+                  pragma Assert
+                    (Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
+                       N_Object_Declaration);
+
+                  Fin_Stmts := New_List (
+                    Make_If_Statement (Loc,
+                      Condition       =>
+                        Make_Op_Ne (Loc,
+                          Left_Opnd  => New_Reference_To (Obj_Id, Loc),
+                          Right_Opnd => Make_Null (Loc)),
+
+                      Then_Statements => Fin_Stmts));
+               end if;
             end if;
          end if;
 
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 60711df..e3304a4 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6189,6 +6189,7 @@ package body Exp_Disp is
       if not No_Run_Time_Mode
         and then Ada_Version >= Ada_2005
         and then RTE_Available (RE_Check_TSD)
+        and then not Debug_Flag_QQ
       then
          Append_To (Elab_Code,
            Make_Procedure_Call_Statement (Loc,
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 7283193..2fd4e44 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -2696,6 +2696,15 @@ package body Exp_Util is
             then
                return True;
 
+            elsif Is_Access_Type (Obj_Typ)
+              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
+              and then Nkind (Return_Flag_Or_Transient_Decl (Obj_Id)) =
+                         N_Object_Declaration
+              and then Is_Finalizable_Transient
+                         (Return_Flag_Or_Transient_Decl (Obj_Id), Decl)
+            then
+               return True;
+
             --  Simple protected objects which use type System.Tasking.
             --  Protected_Objects.Protection to manage their locks should be
             --  treated as controlled since they require manual cleanup.
@@ -2732,7 +2741,7 @@ package body Exp_Util is
 
             elsif Needs_Finalization (Obj_Typ)
               and then Is_Return_Object (Obj_Id)
-              and then Present (Return_Flag (Obj_Id))
+              and then Present (Return_Flag_Or_Transient_Decl (Obj_Id))
             then
                return True;
             end if;
diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb
index ffb8dad..95b5d97 100644
--- a/gcc/ada/expander.adb
+++ b/gcc/ada/expander.adb
@@ -205,6 +205,9 @@ package body Expander is
                when N_Explicit_Dereference =>
                   Expand_N_Explicit_Dereference (N);
 
+               when N_Expression_With_Actions =>
+                  Expand_N_Expression_With_Actions (N);
+
                when N_Extended_Return_Statement =>
                   Expand_N_Extended_Return_Statement (N);
 
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 811e0e0..98d66d3 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -466,10 +466,12 @@ package body Par_SCO is
 
                Loc := Sloc (Parent (Parent (N)));
 
-               --  Record sloc of pragma (pragmas don't nest)
+               if T = 'P' then
+                  --  Record sloc of pragma (pragmas don't nest)
 
-               pragma Assert (Pragma_Sloc = No_Location);
-               Pragma_Sloc := Loc;
+                  pragma Assert (Pragma_Sloc = No_Location);
+                  Pragma_Sloc := Loc;
+               end if;
 
             when 'X' =>
 
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index ba3b683..2f531c9 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -6699,7 +6699,7 @@ package body Prj.Nmsc is
       if Current_Verbosity = High then
          Debug_Increase_Indent
            ("Checking file (rank=" & Source_Dir_Rank'Img & ")",
-            Name_Id (Path));
+            Name_Id (Display_Path));
       end if;
 
       if Name_Loc = No_Name_Location then
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index cd0970a..1ca76d2 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -1626,7 +1626,7 @@ Other library-related attributes can be used to change the defaults:
 
 @item @b{Library_Options}:
 @cindex @code{Library_Options}
-  This attribute may be used to specified additional switches (last switches)
+  This attribute may be used to specify additional switches (last switches)
   when linking a shared library.
 
 @item @b{Leading_Library_Options}:
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index e2e566d..2288ac0 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -755,8 +755,9 @@ package body Sem_Ch10 is
 
       --  If the unit is a subprogram body, then we similarly need to analyze
       --  its spec. However, things are a little simpler in this case, because
-      --  here, this analysis is done only for error checking and consistency
-      --  purposes, so there's nothing else to be done.
+      --  here, this analysis is done mostly for error checking and consistency
+      --  purposes (but not only, e.g. there could be a contract on the spec),
+      --  so there's nothing else to be done.
 
       elsif Nkind (Unit_Node) = N_Subprogram_Body then
          if Acts_As_Spec (N) then
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3c93ca3..b264d8b 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -12446,26 +12446,6 @@ package body Sem_Ch12 is
                --  All other cases than aggregates
 
                else
-                  --  For pragmas, we propagate the Enabled status for the
-                  --  relevant pragmas to the original generic tree. This was
-                  --  originally needed for SCO generation. It is no longer
-                  --  needed there (since we use the Sloc value in calls to
-                  --  Set_SCO_Pragma_Enabled), but it seems a generally good
-                  --  idea to have this flag set properly.
-
-                  if Nkind (N) = N_Pragma
-                    and then
-                      (Pragma_Name (N) = Name_Assert       or else
-                       Pragma_Name (N) = Name_Check        or else
-                       Pragma_Name (N) = Name_Precondition or else
-                       Pragma_Name (N) = Name_Postcondition)
-                    and then Present (Associated_Node (Pragma_Identifier (N)))
-                  then
-                     Set_Pragma_Enabled (N,
-                       Pragma_Enabled
-                         (Parent (Associated_Node (Pragma_Identifier (N)))));
-                  end if;
-
                   Save_Global_Descendant (Field1 (N));
                   Save_Global_Descendant (Field2 (N));
                   Save_Global_Descendant (Field3 (N));
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 1dd2f58..53608c6 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1719,7 +1719,6 @@ package body Sem_Prag is
          --  Record if pragma is enabled
 
          if Check_Enabled (Pname) then
-            Set_Pragma_Enabled (N);
             Set_SCO_Pragma_Enabled (Loc);
          end if;
 
@@ -6695,8 +6694,6 @@ package body Sem_Prag is
             Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
 
             if Check_On then
-               Set_Pragma_Enabled (N);
-               Set_Pragma_Enabled (Original_Node (N));
                Set_SCO_Pragma_Enabled (Loc);
             end if;
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 2a90f67..5d22fb1 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12478,8 +12478,12 @@ package body Sem_Util is
    ----------------
 
    procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id) is
-      Found_Type : constant Entity_Id := First_Subtype (Etype (Expr));
-      Expec_Type : constant Entity_Id := First_Subtype (Expected_Type);
+      Found_Type     : constant Entity_Id := First_Subtype (Etype (Expr));
+      Expec_Type     : constant Entity_Id := First_Subtype (Expected_Type);
+
+      Matching_Field : Entity_Id;
+      --  Entity to give a more precise suggestion on how to write a one-
+      --  element positional aggregate.
 
       function Has_One_Matching_Field return Boolean;
       --  Determines if Expec_Type is a record type with a single component or
@@ -12494,11 +12498,27 @@ package body Sem_Util is
          E : Entity_Id;
 
       begin
+         Matching_Field := Empty;
+
          if Is_Array_Type (Expec_Type)
            and then Number_Dimensions (Expec_Type) = 1
            and then
              Covers (Etype (Component_Type (Expec_Type)), Found_Type)
          then
+            --  Use type name if available. This excludes multidimensional
+            --  arrays and anonymous arrays.
+
+            if Comes_From_Source (Expec_Type) then
+               Matching_Field := Expec_Type;
+
+            --  For an assignment, use name of target.
+
+            elsif Nkind (Parent (Expr)) = N_Assignment_Statement
+              and then Is_Entity_Name (Name (Parent (Expr)))
+            then
+               Matching_Field := Entity (Name (Parent (Expr)));
+            end if;
+
             return True;
 
          elsif not Is_Record_Type (Expec_Type) then
@@ -12529,6 +12549,7 @@ package body Sem_Util is
                return False;
 
             else
+               Matching_Field := E;
                return True;
             end if;
          end if;
@@ -12577,6 +12598,16 @@ package body Sem_Util is
         and then Has_One_Matching_Field
       then
          Error_Msg_N ("positional aggregate cannot have one component", Expr);
+         if Present (Matching_Field) then
+            if Is_Array_Type (Expec_Type) then
+               Error_Msg_NE
+                 ("\write instead `&''First ='> ...`", Expr, Matching_Field);
+
+            else
+               Error_Msg_NE
+                 ("\write instead `& ='> ...`", Expr, Matching_Field);
+            end if;
+         end if;
 
       --  Another special check, if we are looking for a pool-specific access
       --  type and we found an E_Access_Attribute_Type, then we have the case
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index b225b6b..f2a11ba 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2406,14 +2406,6 @@ package body Sinfo is
       return List2 (N);
    end Pragma_Argument_Associations;
 
-   function Pragma_Enabled
-     (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Pragma);
-      return Flag5 (N);
-   end Pragma_Enabled;
-
    function Pragma_Identifier
       (N : Node_Id) return Node_Id is
    begin
@@ -5440,14 +5432,6 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Pragma_Argument_Associations;
 
-   procedure Set_Pragma_Enabled
-     (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Pragma);
-      Set_Flag5 (N, Val);
-   end Set_Pragma_Enabled;
-
    procedure Set_Pragma_Identifier
       (N : Node_Id; Val : Node_Id) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index ad81c77..d859b75 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1587,12 +1587,6 @@ package Sinfo is
    --    package specification. This field is Empty for library bodies (the
    --    parent spec in this case can be found from the corresponding spec).
 
-   --  Pragma_Enabled (Flag5-Sem)
-   --    Present in N_Pragma nodes. This flag is relevant only for pragmas
-   --    Assert, Check, Precondition, and Postcondition. It is true if the
-   --    check corresponding to the pragma type is enabled at the point where
-   --    the pragma appears.
-
    --  Present_Expr (Uint3-Sem)
    --    Present in an N_Variant node. This has a meaningful value only after
    --    Gigi has back annotated the tree with representation information. At
@@ -2062,7 +2056,6 @@ package Sinfo is
       --  Pragma_Argument_Associations (List2) (set to No_List if none)
       --  Pragma_Identifier (Node4)
       --  Next_Rep_Item (Node5-Sem)
-      --  Pragma_Enabled (Flag5-Sem)
       --  From_Aspect_Specification (Flag13-Sem)
       --  Is_Delayed_Aspect (Flag14-Sem)
       --  Import_Interface_Present (Flag16-Sem)
@@ -8734,9 +8727,6 @@ package Sinfo is
    function Pragma_Argument_Associations
      (N : Node_Id) return List_Id;    -- List2
 
-   function Pragma_Enabled
-     (N : Node_Id) return Boolean;    -- Flag5
-
    function Pragma_Identifier
      (N : Node_Id) return Node_Id;    -- Node4
 
@@ -9700,9 +9690,6 @@ package Sinfo is
    procedure Set_Pragma_Argument_Associations
      (N : Node_Id; Val : List_Id);            -- List2
 
-   procedure Set_Pragma_Enabled
-     (N : Node_Id; Val : Boolean := True);    -- Flag5
-
    procedure Set_Pragma_Identifier
      (N : Node_Id; Val : Node_Id);            -- Node4
 
@@ -11897,7 +11884,6 @@ package Sinfo is
    pragma Inline (Parent_Spec);
    pragma Inline (Position);
    pragma Inline (Pragma_Argument_Associations);
-   pragma Inline (Pragma_Enabled);
    pragma Inline (Pragma_Identifier);
    pragma Inline (Pragmas_After);
    pragma Inline (Pragmas_Before);
@@ -12216,7 +12202,6 @@ package Sinfo is
    pragma Inline (Set_Parent_Spec);
    pragma Inline (Set_Position);
    pragma Inline (Set_Pragma_Argument_Associations);
-   pragma Inline (Set_Pragma_Enabled);
    pragma Inline (Set_Pragma_Identifier);
    pragma Inline (Set_Pragmas_After);
    pragma Inline (Set_Pragmas_Before);