[multiple changes]

2014-07-17  Thomas Quinot  <quinot@adacore.com>

	* sem.ads (Scope_Stack_Entry): Reorganize storage of action lists;
	introduce a new list (cleanup actions) for each (transient) scope.
	* sinfo.ads, sinfo.adb (Cleanup_Actions): New attribute for
	N_Block_Statement
	* exp_ch7.ads (Store_Cleanup_Actions_In_Scope): New subprogram.
	* exp_ch7.adb (Store_Actions_In_Scope): New subprogram, common
	processing for Store_xxx_Actions_In_Scope.
	(Build_Cleanup_Statements): Allow for a list of additional
	cleanup statements to be passed by the caller.
	(Expand_Cleanup_Actions): Take custom cleanup actions associated
	with an N_Block_Statement into account.
	(Insert_Actions_In_Scope_Around): Account for Scope_Stack_Entry
	reorganization (refactoring only, no behaviour change).
	(Make_Transient_Block): Add assertion to ensure that the current
	scope is indeed a block (namely, the entity for the transient
	block being constructed syntactically, which has already been
	established as a scope).  If cleanup actions are present in the
	transient scope, transfer them now to the transient block.
	* exp_ch6.adb (Expand_Protected_Subprogram_Call): Freeze the
	called function while it is still present as the name in a call
	in the tree. This may not be the case later on if the call is
	rewritten into a transient block.
	* exp_smem.adb (Add_Shared_Var_Lock_Procs): The post-actions
	inserted after calling a protected operation on a shared passive
	protected must be performed in a block finalizer, not just
	inserted in the tree, so that they are executed even in case of
	a normal (RETURN) or abnormal (exception) transfer of control
	outside of the current scope.
	* exp_smem.ads (Add_Shared_Var_Lock_Procs): Update documentation
	* sem_ch8.adb, expander.adb, exp_ch11.adb: Adjust for
	Scope_Stack_Entry reorganization.

2014-07-17  Thomas Quinot  <quinot@adacore.com>

	* exp_disp.adb (Make_DT, Make_VM_TSD): Do not omit Check_TSD
	call for types that do not have an explicit attribute definition
	clause for External_Tag, as their default tag may clash with an
	explicit tag defined for some other type.

2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Is_Controlled_Function_Call): Recognize a
	controlled function call with multiple actual parameters that
	appears in Object.Operation form.

2014-07-17  Thomas Quinot  <quinot@adacore.com>

	* einfo.ads, einfo.adb (Has_External_Tag_Rep_Clause): Remove
	entity flag.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
	External_Tag): No need to set entity flag.
	* sem_aux.ads, sem_aux.adb (Has_External_Tag_Rep_Clause):
	Reimplement correctly in terms of Has_Rep_Item.

From-SVN: r212719

19 files changed, 321 insertions, 202 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cbcba1d..ce6cade 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,61 @@
 2014-07-17  Thomas Quinot  <quinot@adacore.com>
 
+	* sem.ads (Scope_Stack_Entry): Reorganize storage of action lists;
+	introduce a new list (cleanup actions) for each (transient) scope.
+	* sinfo.ads, sinfo.adb (Cleanup_Actions): New attribute for
+	N_Block_Statement
+	* exp_ch7.ads (Store_Cleanup_Actions_In_Scope): New subprogram.
+	* exp_ch7.adb (Store_Actions_In_Scope): New subprogram, common
+	processing for Store_xxx_Actions_In_Scope.
+	(Build_Cleanup_Statements): Allow for a list of additional
+	cleanup statements to be passed by the caller.
+	(Expand_Cleanup_Actions): Take custom cleanup actions associated
+	with an N_Block_Statement into account.
+	(Insert_Actions_In_Scope_Around): Account for Scope_Stack_Entry
+	reorganization (refactoring only, no behaviour change).
+	(Make_Transient_Block): Add assertion to ensure that the current
+	scope is indeed a block (namely, the entity for the transient
+	block being constructed syntactically, which has already been
+	established as a scope).  If cleanup actions are present in the
+	transient scope, transfer them now to the transient block.
+	* exp_ch6.adb (Expand_Protected_Subprogram_Call): Freeze the
+	called function while it is still present as the name in a call
+	in the tree. This may not be the case later on if the call is
+	rewritten into a transient block.
+	* exp_smem.adb (Add_Shared_Var_Lock_Procs): The post-actions
+	inserted after calling a protected operation on a shared passive
+	protected must be performed in a block finalizer, not just
+	inserted in the tree, so that they are executed even in case of
+	a normal (RETURN) or abnormal (exception) transfer of control
+	outside of the current scope.
+	* exp_smem.ads (Add_Shared_Var_Lock_Procs): Update documentation
+	* sem_ch8.adb, expander.adb, exp_ch11.adb: Adjust for
+	Scope_Stack_Entry reorganization.
+
+2014-07-17  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_disp.adb (Make_DT, Make_VM_TSD): Do not omit Check_TSD
+	call for types that do not have an explicit attribute definition
+	clause for External_Tag, as their default tag may clash with an
+	explicit tag defined for some other type.
+
+2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Is_Controlled_Function_Call): Recognize a
+	controlled function call with multiple actual parameters that
+	appears in Object.Operation form.
+
+2014-07-17  Thomas Quinot  <quinot@adacore.com>
+
+	* einfo.ads, einfo.adb (Has_External_Tag_Rep_Clause): Remove
+	entity flag.
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
+	External_Tag): No need to set entity flag.
+	* sem_aux.ads, sem_aux.adb (Has_External_Tag_Rep_Clause):
+	Reimplement correctly in terms of Has_Rep_Item.
+
+2014-07-17  Thomas Quinot  <quinot@adacore.com>
+
 	* exp_ch7.adb (Establish_Transient_Scope.Find_Node_To_Be_Wrapped):
 	Start examining the tree at the node passed to
 	Establish_Transient_Scope (not its parent).
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 22bd41f..13349e1 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -384,7 +384,6 @@ package body Einfo is
    --    Is_Private_Composite            Flag107
    --    Default_Expressions_Processed   Flag108
    --    Is_Non_Static_Subtype           Flag109
-   --    Has_External_Tag_Rep_Clause     Flag110
 
    --    Is_Formal_Subprogram            Flag111
    --    Is_Renaming_Of_Object           Flag112
@@ -564,6 +563,8 @@ package body Einfo is
    --    (unused)                        Flag2
    --    (unused)                        Flag3
 
+   --    (unused)                        Flag110
+
    --    (unused)                        Flag269
    --    (unused)                        Flag270
 
@@ -1443,12 +1444,6 @@ package body Einfo is
       return Flag47 (Id);
    end Has_Exit;
 
-   function Has_External_Tag_Rep_Clause (Id : E) return B is
-   begin
-      pragma Assert (Is_Tagged_Type (Id));
-      return Flag110 (Id);
-   end Has_External_Tag_Rep_Clause;
-
    function Has_Forward_Instantiation (Id : E) return B is
    begin
       return Flag175 (Id);
@@ -4150,12 +4145,6 @@ package body Einfo is
       Set_Flag47 (Id, V);
    end Set_Has_Exit;
 
-   procedure Set_Has_External_Tag_Rep_Clause (Id : E; V : B := True) is
-   begin
-      pragma Assert (Is_Tagged_Type (Id));
-      Set_Flag110 (Id, V);
-   end Set_Has_External_Tag_Rep_Clause;
-
    procedure Set_Has_Forward_Instantiation (Id : E; V : B := True) is
    begin
       Set_Flag175 (Id, V);
@@ -8188,7 +8177,6 @@ package body Einfo is
       W ("Has_Dynamic_Predicate_Aspect",    Flag258 (Id));
       W ("Has_Enumeration_Rep_Clause",      Flag66  (Id));
       W ("Has_Exit",                        Flag47  (Id));
-      W ("Has_External_Tag_Rep_Clause",     Flag110 (Id));
       W ("Has_Forward_Instantiation",       Flag175 (Id));
       W ("Has_Fully_Qualified_Name",        Flag173 (Id));
       W ("Has_Gigi_Rep_Item",               Flag82  (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 51b537b..a234634 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1528,11 +1528,6 @@ package Einfo is
 --       that this does not imply a representation with holes, since the rep
 --       clause may merely confirm the default 0..N representation.
 
---    Has_External_Tag_Rep_Clause (Flag110)
---       Defined in tagged types. Set if an external_tag rep. clause has been
---       given for this type. Use to avoid the generation of the default
---       external_tag.
-
 --    Has_Exit (Flag47)
 --       Defined in loop entities. Set if the loop contains an exit statement.
 
@@ -5951,7 +5946,6 @@ package Einfo is
    --    Component_Alignment                 (special)  (base type only)
    --    C_Pass_By_Copy                      (Flag125)  (base type only)
    --    Has_Dispatch_Table                  (Flag220)  (base tagged type only)
-   --    Has_External_Tag_Rep_Clause         (Flag110)
    --    Has_Pragma_Pack                     (Flag121)  (impl base type only)
    --    Has_Private_Ancestor                (Flag151)
    --    Has_Record_Rep_Clause               (Flag65)   (base type only)
@@ -5983,7 +5977,6 @@ package Einfo is
    --    Has_Completion                      (Flag26)
    --    Has_Private_Ancestor                (Flag151)
    --    Has_Record_Rep_Clause               (Flag65)   (base type only)
-   --    Has_External_Tag_Rep_Clause         (Flag110)
    --    Is_Concurrent_Record_Type           (Flag20)
    --    Is_Constrained                      (Flag12)
    --    Is_Controlled                       (Flag42)   (base type only)
@@ -6488,7 +6481,6 @@ package Einfo is
    function Has_Dynamic_Predicate_Aspect        (Id : E) return B;
    function Has_Enumeration_Rep_Clause          (Id : E) return B;
    function Has_Exit                            (Id : E) return B;
-   function Has_External_Tag_Rep_Clause         (Id : E) return B;
    function Has_Forward_Instantiation           (Id : E) return B;
    function Has_Fully_Qualified_Name            (Id : E) return B;
    function Has_Gigi_Rep_Item                   (Id : E) return B;
@@ -7114,7 +7106,6 @@ package Einfo is
    procedure Set_Has_Dynamic_Predicate_Aspect    (Id : E; V : B := True);
    procedure Set_Has_Enumeration_Rep_Clause      (Id : E; V : B := True);
    procedure Set_Has_Exit                        (Id : E; V : B := True);
-   procedure Set_Has_External_Tag_Rep_Clause     (Id : E; V : B := True);
    procedure Set_Has_Forward_Instantiation       (Id : E; V : B := True);
    procedure Set_Has_Fully_Qualified_Name        (Id : E; V : B := True);
    procedure Set_Has_Gigi_Rep_Item               (Id : E; V : B := True);
@@ -7853,7 +7844,6 @@ package Einfo is
    pragma Inline (Has_Dynamic_Predicate_Aspect);
    pragma Inline (Has_Enumeration_Rep_Clause);
    pragma Inline (Has_Exit);
-   pragma Inline (Has_External_Tag_Rep_Clause);
    pragma Inline (Has_Forward_Instantiation);
    pragma Inline (Has_Fully_Qualified_Name);
    pragma Inline (Has_Gigi_Rep_Item);
@@ -8326,7 +8316,6 @@ package Einfo is
    pragma Inline (Set_Has_Dynamic_Predicate_Aspect);
    pragma Inline (Set_Has_Enumeration_Rep_Clause);
    pragma Inline (Set_Has_Exit);
-   pragma Inline (Set_Has_External_Tag_Rep_Clause);
    pragma Inline (Set_Has_Forward_Instantiation);
    pragma Inline (Set_Has_Fully_Qualified_Name);
    pragma Inline (Set_Has_Gigi_Rep_Item);
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 8951ffb..1a27245 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -1960,9 +1960,11 @@ package body Exp_Ch11 is
                begin
                   if LCN = Statements (P)
                        or else
-                     LCN = SSE.Actions_To_Be_Wrapped_Before
+                     LCN = SSE.Actions_To_Be_Wrapped (Before)
                        or else
-                     LCN = SSE.Actions_To_Be_Wrapped_After
+                     LCN = SSE.Actions_To_Be_Wrapped (After)
+                       or else
+                     LCN = SSE.Actions_To_Be_Wrapped (Cleanup)
                   then
                      --  Loop through exception handlers
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index de0a4e2..4a92896 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7150,6 +7150,26 @@ package body Exp_Ch6 is
    is
       Rec   : Node_Id;
 
+      procedure Freeze_Called_Function;
+      --  If it is a function call it can appear in elaboration code and
+      --  the called entity must be frozen before the call. This must be
+      --  done before the call is expanded, as the expansion may rewrite it
+      --  to something other than a call (e.g. a temporary initialized in a
+      --  transient block).
+
+      ----------------------------
+      -- Freeze_Called_Function --
+      ----------------------------
+
+      procedure Freeze_Called_Function is
+      begin
+         if Ekind (Subp) = E_Function then
+            Freeze_Expression (Name (N));
+         end if;
+      end Freeze_Called_Function;
+
+   --  Start of processing for Expand_Protected_Subprogram_Call
+
    begin
       --  If the protected object is not an enclosing scope, this is an inter-
       --  object function call. Inter-object procedure calls are expanded by
@@ -7170,6 +7190,7 @@ package body Exp_Ch6 is
             Rec := Prefix (Prefix (Name (N)));
          end if;
 
+         Freeze_Called_Function;
          Build_Protected_Subprogram_Call (N,
            Name     => New_Occurrence_Of (Subp, Sloc (N)),
            Rec      => Convert_Concurrent (Rec, Etype (Rec)),
@@ -7182,6 +7203,7 @@ package body Exp_Ch6 is
             return;
          end if;
 
+         Freeze_Called_Function;
          Build_Protected_Subprogram_Call (N,
            Name     => Name (N),
            Rec      => Rec,
@@ -7189,13 +7211,6 @@ package body Exp_Ch6 is
 
       end if;
 
-      --  If it is a function call it can appear in elaboration code and
-      --  the called entity must be frozen here.
-
-      if Ekind (Subp) = E_Function then
-         Freeze_Expression (Name (N));
-      end if;
-
       --  Analyze and resolve the new call. The actuals have already been
       --  resolved, but expansion of a function call will add extra actuals
       --  if needed. Analysis of a procedure call already includes resolution.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 02c2219..f48f114 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -150,6 +150,9 @@ package body Exp_Ch7 is
    --  ??? The entire comment needs to be rewritten
    --  ??? which entire comment?
 
+   procedure Store_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id);
+   --  Shared processing for Store_xxx_Actions_In_Scope
+
    -----------------------------
    -- Finalization Management --
    -----------------------------
@@ -296,11 +299,14 @@ package body Exp_Ch7 is
    --  Build the deep Initialize/Adjust/Finalize for a record Typ with
    --  Has_Controlled_Component set and store them using the TSS mechanism.
 
-   function Build_Cleanup_Statements (N : Node_Id) return List_Id;
+   function Build_Cleanup_Statements
+     (N                  : Node_Id;
+      Additional_Cleanup : List_Id) return List_Id;
    --  Create the clean up calls for an asynchronous call block, task master,
-   --  protected subprogram body, task allocation block or task body. If the
-   --  context does not contain the above constructs, the routine returns an
-   --  empty list.
+   --  protected subprogram body, task allocation block or task body, or
+   --  additional cleanup actions parked on a transient block. If the context
+   --  does not contain the above constructs, the routine returns an empty
+   --  list.
 
    procedure Build_Finalizer
      (N           : Node_Id;
@@ -467,7 +473,10 @@ package body Exp_Ch7 is
    -- Build_Cleanup_Statements --
    ------------------------------
 
-   function Build_Cleanup_Statements (N : Node_Id) return List_Id is
+   function Build_Cleanup_Statements
+     (N                  : Node_Id;
+      Additional_Cleanup : List_Id) return List_Id
+   is
       Is_Asynchronous_Call : constant Boolean :=
                                Nkind (N) = N_Block_Statement
                                  and then Is_Asynchronous_Call_Block (N);
@@ -626,6 +635,7 @@ package body Exp_Ch7 is
          end;
       end if;
 
+      Append_List_To (Stmts, Additional_Cleanup);
       return Stmts;
    end Build_Cleanup_Statements;
 
@@ -792,9 +802,7 @@ package body Exp_Ch7 is
    --  Start of processing for Build_Finalization_Master
 
    begin
-      if Is_Private_Type (Ptr_Typ)
-        and then Present (Full_View (Ptr_Typ))
-      then
+      if Is_Private_Type (Ptr_Typ) and then Present (Full_View (Ptr_Typ)) then
          Ptr_Typ := Full_View (Ptr_Typ);
       end if;
 
@@ -887,9 +895,7 @@ package body Exp_Ch7 is
          --  inserted in the same source unit only once. The only exception to
          --  this are instances using the same access type as generic actual.
 
-         if Comes_From_Source (Ptr_Typ)
-           and then not Inside_A_Generic
-         then
+         if Comes_From_Source (Ptr_Typ) and then not Inside_A_Generic then
             Fin_Mas_Id :=
               Make_Defining_Identifier (Loc,
                 Chars => New_External_Name (Chars (Ptr_Typ), "FM"));
@@ -1436,9 +1442,7 @@ package body Exp_Ch7 is
                 Expression   => Make_Identifier (Loc, Chars (Counter_Id)),
                 Alternatives => Jump_Alts);
 
-            if Acts_As_Clean
-              and then Present (Jump_Block_Insert_Nod)
-            then
+            if Acts_As_Clean and then Present (Jump_Block_Insert_Nod) then
                Insert_After (Jump_Block_Insert_Nod, Jump_Block);
             else
                Prepend_To (Finalizer_Stmts, Jump_Block);
@@ -1481,10 +1485,7 @@ package body Exp_Ch7 is
          --  aborts are allowed and the clean up statements require deferral or
          --  there are controlled objects to be finalized.
 
-         if Abort_Allowed
-           and then
-             (Defer_Abort or else Has_Ctrl_Objs)
-         then
+         if Abort_Allowed and then (Defer_Abort or Has_Ctrl_Objs) then
             Prepend_To (Finalizer_Stmts,
               Make_Procedure_Call_Statement (Loc,
                 Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc)));
@@ -1502,10 +1503,7 @@ package body Exp_Ch7 is
          --       Raise_From_Controlled_Operation (E);
          --    end if;
 
-         if Has_Ctrl_Objs
-           and then Exceptions_OK
-           and then not For_Package
-         then
+         if Has_Ctrl_Objs and Exceptions_OK and not For_Package then
             Append_To (Finalizer_Stmts,
               Build_Raise_Statement (Finalizer_Data));
          end if;
@@ -1608,9 +1606,7 @@ package body Exp_Ch7 is
             --  When the finalizer acts solely as a clean up routine, the body
             --  is inserted right after the spec.
 
-            if Acts_As_Clean
-              and then not Has_Ctrl_Objs
-            then
+            if Acts_As_Clean and then not Has_Ctrl_Objs then
                Insert_After (Fin_Spec, Fin_Body);
 
             --  In all other cases the body is inserted after either:
@@ -1706,9 +1702,7 @@ package body Exp_Ch7 is
                if Preprocess then
                   Has_Tagged_Types := True;
 
-                  if Top_Level
-                    and then No (Last_Top_Level_Ctrl_Construct)
-                  then
+                  if Top_Level and then No (Last_Top_Level_Ctrl_Construct) then
                      Last_Top_Level_Ctrl_Construct := Decl;
                   end if;
 
@@ -1723,9 +1717,7 @@ package body Exp_Ch7 is
                   Counter_Val   := Counter_Val + 1;
                   Has_Ctrl_Objs := True;
 
-                  if Top_Level
-                    and then No (Last_Top_Level_Ctrl_Construct)
-                  then
+                  if Top_Level and then No (Last_Top_Level_Ctrl_Construct) then
                      Last_Top_Level_Ctrl_Construct := Decl;
                   end if;
 
@@ -1774,9 +1766,7 @@ package body Exp_Ch7 is
                --  finalization disabled. This applies only to objects at the
                --  library level.
 
-               if For_Package
-                 and then Finalize_Storage_Only (Obj_Typ)
-               then
+               if For_Package and then Finalize_Storage_Only (Obj_Typ) then
                   null;
 
                --  Transient variables are treated separately in order to
@@ -1824,7 +1814,7 @@ package body Exp_Ch7 is
                elsif Is_Access_Type (Obj_Typ)
                  and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
                  and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
-                                   N_Object_Declaration
+                                                        N_Object_Declaration
                  and then Is_Finalizable_Transient
                             (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
                then
@@ -1893,9 +1883,7 @@ package body Exp_Ch7 is
                --  finalization disabled. This applies only to objects at the
                --  library level.
 
-               if For_Package
-                 and then Finalize_Storage_Only (Obj_Typ)
-               then
+               if For_Package and then Finalize_Storage_Only (Obj_Typ) then
                   null;
 
                --  Return object of a build-in-place function. This case is
@@ -3534,9 +3522,7 @@ package body Exp_Ch7 is
 
    begin
       Func_Id := E;
-      while Present (Func_Id)
-        and then Func_Id /= Standard_Standard
-      loop
+      while Present (Func_Id) and then Func_Id /= Standard_Standard loop
          if Ekind (Func_Id) = E_Function then
             return Func_Id;
          end if;
@@ -3691,6 +3677,9 @@ package body Exp_Ch7 is
                                  and then
                                    not Sec_Stack_Needed_For_Return (Scop)
                                  and then VM_Target = No_VM;
+      Needs_Custom_Cleanup : constant Boolean :=
+                               Nkind (N) = N_Block_Statement
+                                 and then Present (Cleanup_Actions (N));
 
       Actions_Required     : constant Boolean :=
                                Requires_Cleanup_Actions (N, True)
@@ -3699,10 +3688,12 @@ package body Exp_Ch7 is
                                  or else Is_Protected_Body
                                  or else Is_Task_Allocation
                                  or else Is_Task_Body
-                                 or else Needs_Sec_Stack_Mark;
+                                 or else Needs_Sec_Stack_Mark
+                                 or else Needs_Custom_Cleanup;
 
       HSS : Node_Id := Handled_Statement_Sequence (N);
       Loc : Source_Ptr;
+      Cln : List_Id;
 
       procedure Wrap_HSS_In_Block;
       --  Move HSS inside a new block along with the original exception
@@ -3761,6 +3752,12 @@ package body Exp_Ch7 is
          return;
       end if;
 
+      if Needs_Custom_Cleanup then
+         Cln := Cleanup_Actions (N);
+      else
+         Cln := No_List;
+      end if;
+
       declare
          Decls     : List_Id := Declarations (N);
          Fin_Id    : Entity_Id;
@@ -3898,7 +3895,7 @@ package body Exp_Ch7 is
 
          Build_Finalizer
            (N           => N,
-            Clean_Stmts => Build_Cleanup_Statements (N),
+            Clean_Stmts => Build_Cleanup_Statements (N, Cln),
             Mark_Id     => Mark,
             Top_Decls   => New_Decls,
             Defer_Abort => Nkind (Original_Node (N)) = N_Task_Body
@@ -4440,10 +4437,10 @@ package body Exp_Ch7 is
    ------------------------------------
 
    procedure Insert_Actions_In_Scope_Around (N : Node_Id) is
-      After  : constant List_Id :=
-        Scope_Stack.Table (Scope_Stack.Last).Actions_To_Be_Wrapped_After;
-      Before : constant List_Id :=
-        Scope_Stack.Table (Scope_Stack.Last).Actions_To_Be_Wrapped_Before;
+      Act_After   : constant List_Id :=
+        Scope_Stack.Table (Scope_Stack.Last).Actions_To_Be_Wrapped (After);
+      Act_Before  : constant List_Id :=
+        Scope_Stack.Table (Scope_Stack.Last).Actions_To_Be_Wrapped (Before);
       --  Note: We used to use renamings of Scope_Stack.Table (Scope_Stack.
       --  Last), but this was incorrect as Process_Transient_Object may
       --  introduce new scopes and cause a reallocation of Scope_Stack.Table.
@@ -4794,7 +4791,7 @@ package body Exp_Ch7 is
    --  Start of processing for Insert_Actions_In_Scope_Around
 
    begin
-      if No (Before) and then No (After) then
+      if No (Act_Before) and then No (Act_After) then
          return;
       end if;
 
@@ -4833,22 +4830,22 @@ package body Exp_Ch7 is
 
          --    3)                   Target ........ Last_Obj
 
-         if Present (Before) then
+         if Present (Act_Before) then
 
             --  Flag declarations are inserted before the first object
 
-            First_Obj := First (Before);
+            First_Obj := First (Act_Before);
 
-            Insert_List_Before (Target, Before);
+            Insert_List_Before (Target, Act_Before);
          end if;
 
-         if Present (After) then
+         if Present (Act_After) then
 
             --  Finalization calls are inserted after the last object
 
-            Last_Obj := Last (After);
+            Last_Obj := Last (Act_After);
 
-            Insert_List_After (Target, After);
+            Insert_List_After (Target, Act_After);
          end if;
 
          --  Check for transient controlled objects associated with Target and
@@ -4861,14 +4858,14 @@ package body Exp_Ch7 is
 
          --  Reset the action lists
 
-         if Present (Before) then
+         if Present (Act_Before) then
             Scope_Stack.Table (Scope_Stack.Last).
-              Actions_To_Be_Wrapped_Before := No_List;
+              Actions_To_Be_Wrapped (Before) := No_List;
          end if;
 
-         if Present (After) then
+         if Present (Act_After) then
             Scope_Stack.Table (Scope_Stack.Last).
-              Actions_To_Be_Wrapped_After := No_List;
+              Actions_To_Be_Wrapped (After) := No_List;
          end if;
       end;
    end Insert_Actions_In_Scope_Around;
@@ -6564,9 +6561,7 @@ package body Exp_Ch7 is
             --  order to generate the same state counter names as those from
             --  Build_Initialize_Statements.
 
-            if Num_Comps > 0
-              and then Is_Local
-            then
+            if Num_Comps > 0 and then Is_Local then
                Counter := Counter + 1;
 
                Counter_Id :=
@@ -7253,7 +7248,7 @@ package body Exp_Ch7 is
                   Ekind (Typ) = E_Record_Type
                     and then Is_Concurrent_Record_Type (Typ)
                     and then Ekind (Corresponding_Concurrent_Type (Typ)) =
-                               E_Task_Type;
+                                                                 E_Task_Type;
       Loc     : constant Source_Ptr := Sloc (Typ);
       Proc_Id : Entity_Id;
       Stmts   : List_Id;
@@ -7832,8 +7827,10 @@ package body Exp_Ch7 is
       end if;
 
       --  Create the transient block. Set the parent now since the block itself
-      --  is not part of the tree.
+      --  is not part of the tree. The current scope is the E_Block entity
+      --  that has been pushed by Establish_Transient_Scope.
 
+      pragma Assert (Ekind (Current_Scope) = E_Block);
       Block :=
         Make_Block_Statement (Loc,
           Identifier                 => New_Occurrence_Of (Current_Scope, Loc),
@@ -7853,6 +7850,17 @@ package body Exp_Ch7 is
          Freeze_All (First_Entity (Current_Scope), Insert);
       end if;
 
+      --  Transfer cleanup actions to the newly created block
+
+      declare
+         Cleanup_Actions : List_Id
+           renames Scope_Stack.Table (Scope_Stack.Last).
+                     Actions_To_Be_Wrapped (Cleanup);
+      begin
+         Set_Cleanup_Actions (Block, Cleanup_Actions);
+         Cleanup_Actions := No_List;
+      end;
+
       --  When the transient scope was established, we pushed the entry for the
       --  transient scope onto the scope stack, so that the scope was active
       --  for the installation of finalizable entities etc. Now we must remove
@@ -7881,20 +7889,17 @@ package body Exp_Ch7 is
       Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped := N;
    end Set_Node_To_Be_Wrapped;
 
-   ----------------------------------
-   -- Store_After_Actions_In_Scope --
-   ----------------------------------
+   ----------------------------
+   -- Store_Actions_In_Scope --
+   ----------------------------
 
-   procedure Store_After_Actions_In_Scope (L : List_Id) is
-      SE : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
+   procedure Store_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id) is
+      SE      : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
+      Actions : List_Id renames SE.Actions_To_Be_Wrapped (AK);
 
    begin
-      if Present (SE.Actions_To_Be_Wrapped_After) then
-         Insert_List_Before_And_Analyze
-           (First (SE.Actions_To_Be_Wrapped_After), L);
-
-      else
-         SE.Actions_To_Be_Wrapped_After := L;
+      if No (Actions) then
+         Actions := L;
 
          if Is_List_Member (SE.Node_To_Be_Wrapped) then
             Set_Parent (L, Parent (SE.Node_To_Be_Wrapped));
@@ -7903,7 +7908,22 @@ package body Exp_Ch7 is
          end if;
 
          Analyze_List (L);
+
+      elsif AK = Before then
+         Insert_List_After_And_Analyze (Last (Actions), L);
+
+      else
+         Insert_List_Before_And_Analyze (First (Actions), L);
       end if;
+   end Store_Actions_In_Scope;
+
+   ----------------------------------
+   -- Store_After_Actions_In_Scope --
+   ----------------------------------
+
+   procedure Store_After_Actions_In_Scope (L : List_Id) is
+   begin
+      Store_Actions_In_Scope (After, L);
    end Store_After_Actions_In_Scope;
 
    -----------------------------------
@@ -7911,25 +7931,18 @@ package body Exp_Ch7 is
    -----------------------------------
 
    procedure Store_Before_Actions_In_Scope (L : List_Id) is
-      SE : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
-
    begin
-      if Present (SE.Actions_To_Be_Wrapped_Before) then
-         Insert_List_After_And_Analyze
-           (Last (SE.Actions_To_Be_Wrapped_Before), L);
-
-      else
-         SE.Actions_To_Be_Wrapped_Before := L;
+      Store_Actions_In_Scope (Before, L);
+   end Store_Before_Actions_In_Scope;
 
-         if Is_List_Member (SE.Node_To_Be_Wrapped) then
-            Set_Parent (L, Parent (SE.Node_To_Be_Wrapped));
-         else
-            Set_Parent (L, SE.Node_To_Be_Wrapped);
-         end if;
+   -----------------------------------
+   -- Store_Cleanup_Actions_In_Scope --
+   -----------------------------------
 
-         Analyze_List (L);
-      end if;
-   end Store_Before_Actions_In_Scope;
+   procedure Store_Cleanup_Actions_In_Scope (L : List_Id) is
+   begin
+      Store_Actions_In_Scope (Cleanup, L);
+   end Store_Cleanup_Actions_In_Scope;
 
    --------------------------------
    -- Wrap_Transient_Declaration --
diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads
index ba141cb..86faac9 100644
--- a/gcc/ada/exp_ch7.ads
+++ b/gcc/ada/exp_ch7.ads
@@ -302,6 +302,10 @@ package Exp_Ch7 is
    --  stored in the top of the scope stack (also analyzes these actions).
    --  Why prepend rather than append ???
 
+   procedure Store_Cleanup_Actions_In_Scope (L : List_Id);
+   --  Prepend the list L of actions to the beginning of the cleanup-actions
+   --  store in the top of the scope stack.
+
    procedure Wrap_Transient_Declaration (N : Node_Id);
    --  N is an object declaration. Expand the finalization calls after the
    --  declaration and make the outer scope being the transient one.
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index da2b55d..8b4977b 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -6209,9 +6209,8 @@ package body Exp_Disp is
          end if;
       end if;
 
-      --  If the type has a representation clause which specifies its external
-      --  tag then generate code to check if the external tag of this type is
-      --  the same as the external tag of some other declaration.
+      --  Generate code to check if the external tag of this type is the same
+      --  as the external tag of some other declaration.
 
       --     Check_TSD (TSD'Unrestricted_Access);
 
@@ -6226,16 +6225,16 @@ package body Exp_Disp is
 
       if not No_Run_Time_Mode
         and then Ada_Version >= Ada_2005
-        and then Has_External_Tag_Rep_Clause (Typ)
         and then RTE_Available (RE_Check_TSD)
         and then not Debug_Flag_QQ
       then
          Append_To (Elab_Code,
            Make_Procedure_Call_Statement (Loc,
-             Name => New_Occurrence_Of (RTE (RE_Check_TSD), Loc),
+             Name                   =>
+               New_Occurrence_Of (RTE (RE_Check_TSD), Loc),
              Parameter_Associations => New_List (
                Make_Attribute_Reference (Loc,
-                 Prefix => New_Occurrence_Of (TSD, Loc),
+                 Prefix         => New_Occurrence_Of (TSD, Loc),
                  Attribute_Name => Name_Unchecked_Access))));
       end if;
 
@@ -6810,12 +6809,10 @@ package body Exp_Disp is
             Expressions => TSD_Aggr_List)));
 
       --  Generate:
-      --     Check_TSD
-      --       (TSD => TSD'Unrestricted_Access);
+      --     Check_TSD (TSD => TSD'Unrestricted_Access);
 
       if Ada_Version >= Ada_2005
         and then Is_Library_Level_Entity (Typ)
-        and then Has_External_Tag_Rep_Clause (Typ)
         and then RTE_Available (RE_Check_TSD)
         and then not Debug_Flag_QQ
       then
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb
index 8ee6702..819de1d 100644
--- a/gcc/ada/exp_smem.adb
+++ b/gcc/ada/exp_smem.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2014, 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- --
@@ -129,62 +129,65 @@ package body Exp_Smem is
    -------------------------------
 
    procedure Add_Shared_Var_Lock_Procs (N : Node_Id) is
-      Loc   : constant Source_Ptr := Sloc (N);
-      Obj   : constant Entity_Id  := Entity (Expression (First_Actual (N)));
-      Inode : Node_Id;
-      Vnm   : String_Id;
+      Loc : constant Source_Ptr := Sloc (N);
+      Obj : constant Entity_Id  := Entity (Expression (First_Actual (N)));
+      Vnm : String_Id;
+      Vid : Entity_Id;
+      Aft : constant List_Id := New_List;
 
    begin
-      --  We have to add Shared_Var_Lock and Shared_Var_Unlock calls around
-      --  the procedure or function call node. First we locate the right place
-      --  to do the insertion, which is the call itself in the procedure call
-      --  case, or else the nearest non subexpression node that contains the
-      --  function call.
-
-      Inode := N;
-      while Nkind (Inode) /= N_Procedure_Call_Statement
-        and then Nkind (Inode) in N_Subexpr
-      loop
-         Inode := Parent (Inode);
-      end loop;
-
-      --  Now insert the Lock and Unlock calls and the read/write calls
-
-      --  Two concerns here. First we are not dealing with the exception case,
-      --  really we need some kind of cleanup routine to do the Unlock. Second,
-      --  these lock calls should be inside the protected object processing,
-      --  not outside, otherwise they can be done at the wrong priority,
-      --  resulting in dead lock situations ???
-
       Build_Full_Name (Obj, Vnm);
 
+      --  Create constant string. Note that this must be done prior to
+      --  establishing the transient scope, as the finalizer needs to have
+      --  access to this object.
+
+      Vid := Make_Temporary (Loc, 'N', Obj);
+      Insert_Action (N,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Vid,
+          Constant_Present    => True,
+          Object_Definition   => New_Occurrence_Of (Standard_String, Loc),
+          Expression          => Make_String_Literal (Loc, Vnm)));
+
+      --  Now set up a transient scope around the call, which will hold the
+      --  required lock/unlock actions.
+
+      Establish_Transient_Scope (N, Sec_Stack => False);
+
       --  First insert the Lock call before
 
-      Insert_Before_And_Analyze (Inode,
+      Insert_Action (N,
         Make_Procedure_Call_Statement (Loc,
           Name => New_Occurrence_Of (RTE (RE_Shared_Var_Lock), Loc),
-          Parameter_Associations => New_List (
-            Make_String_Literal (Loc, Vnm))));
+          Parameter_Associations => New_List (New_Occurrence_Of (Vid, Loc))));
 
       --  Now, right after the Lock, insert a call to read the object
 
-      Insert_Before_And_Analyze (Inode,
+      Insert_Action (N,
         Build_Shared_Var_Proc_Call (Loc, Obj, Name_Read));
 
-      --  Now insert the Unlock call after
+      --  Now for a procedure call, but not a function call, insert the
+      --  call to write the object just before the unlock.
 
-      Insert_After_And_Analyze (Inode,
+      if Nkind (N) = N_Procedure_Call_Statement then
+         Append_To (Aft,
+           Build_Shared_Var_Proc_Call (Loc, Obj, Name_Write));
+      end if;
+
+      --  Finally insert the Unlock call after
+
+      Append_To (Aft,
         Make_Procedure_Call_Statement (Loc,
           Name => New_Occurrence_Of (RTE (RE_Shared_Var_Unlock), Loc),
-          Parameter_Associations => New_List (
-            Make_String_Literal (Loc, Vnm))));
+          Parameter_Associations => New_List (New_Occurrence_Of (Vid, Loc))));
 
-      --  Now for a procedure call, but not a function call, insert the
-      --  call to write the object just before the unlock.
+      Store_Cleanup_Actions_In_Scope (Aft);
 
       if Nkind (N) = N_Procedure_Call_Statement then
-         Insert_After_And_Analyze (Inode,
-           Build_Shared_Var_Proc_Call (Loc, Obj, Name_Write));
+         Wrap_Transient_Statement (N);
+      else
+         Wrap_Transient_Expression (N);
       end if;
    end Add_Shared_Var_Lock_Procs;
 
diff --git a/gcc/ada/exp_smem.ads b/gcc/ada/exp_smem.ads
index d173825..9596350 100644
--- a/gcc/ada/exp_smem.ads
+++ b/gcc/ada/exp_smem.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1998-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2014, 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- --
@@ -44,9 +44,10 @@ package Exp_Smem is
    --  The argument is a protected subprogram call, before it is rewritten
    --  by Exp_Ch9.Build_Protected_Subprogram_Call. This routine, which is
    --  called only in the case of an external call to a protected object
-   --  that has Is_Shared_Passive set, deals with installing the required
-   --  global lock calls for this case. It also generates the necessary
-   --  read/write calls for the protected object within the lock region.
+   --  that has Is_Shared_Passive set, deals with installing a transient scope
+   --  and acquiring the appropriate global lock calls for this case. It also
+   --  generates the necessary read/write calls for the protected object within
+   --  the lock region.
 
    function Make_Shared_Var_Procs (N : Node_Id) return Node_Id;
    --  N is the node for the declaration of a shared passive variable.
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2d2d7f5..14895f5 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4214,7 +4214,8 @@ package body Exp_Util is
      (Obj_Id : Entity_Id) return Boolean
    is
       function Is_Controlled_Function_Call (N : Node_Id) return Boolean;
-      --  Determine if particular node denotes a controlled function call
+      --  Determine if particular node denotes a controlled function call. The
+      --  call may have been heavily expanded.
 
       function Is_Displace_Call (N : Node_Id) return Boolean;
       --  Determine whether a particular node is a call to Ada.Tags.Displace.
@@ -4233,12 +4234,22 @@ package body Exp_Util is
       begin
          if Nkind (Expr) = N_Function_Call then
             Expr := Name (Expr);
-         end if;
 
-         --  The function call may appear in object.operation format
+         --  When a function call appears in Object.Operation format, the
+         --  original representation has two possible forms depending on the
+         --  availability of actual parameters:
+         --
+         --    Obj.Func_Call          --  N_Selected_Component
+         --    Obj.Func_Call (Param)  --  N_Indexed_Component
 
-         if Nkind (Expr) = N_Selected_Component then
-            Expr := Selector_Name (Expr);
+         else
+            if Nkind (Expr) = N_Indexed_Component then
+               Expr := Prefix (Expr);
+            end if;
+
+            if Nkind (Expr) = N_Selected_Component then
+               Expr := Selector_Name (Expr);
+            end if;
          end if;
 
          return
diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb
index f6e65e7..4d15e09 100644
--- a/gcc/ada/expander.adb
+++ b/gcc/ada/expander.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -119,10 +119,7 @@ package body Expander is
 
          if Serious_Errors_Detected > 0 and then Scope_Is_Transient then
             Scope_Stack.Table
-             (Scope_Stack.Last).Actions_To_Be_Wrapped_Before := No_List;
-            Scope_Stack.Table
-             (Scope_Stack.Last).Actions_To_Be_Wrapped_After  := No_List;
-
+             (Scope_Stack.Last).Actions_To_Be_Wrapped := (others => No_List);
             Pop_Scope;
          end if;
 
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 3430818..667fbc1 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -450,6 +450,11 @@ package Sem is
    --  units and their instantiations, have led to a hybrid model that carries
    --  more state than one would wish.
 
+   type Scope_Action_Kind is (Before, After, Cleanup);
+   type Scope_Actions is array (Scope_Action_Kind) of List_Id;
+   --  Transient blocks have three associated actions list, to be inserted
+   --  before and after the block's statements, and as cleanup actions.
+
    type Scope_Stack_Entry is record
       Entity : Entity_Id;
       --  Entity representing the scope
@@ -496,11 +501,11 @@ package Sem is
       --  Only used in transient scopes. Records the node which will
       --  be wrapped by the transient block.
 
-      Actions_To_Be_Wrapped_Before : List_Id;
-      Actions_To_Be_Wrapped_After  : List_Id;
-      --  Actions that have to be inserted at the start or at the end of a
-      --  transient block. Used to temporarily hold these actions until the
-      --  block is created, at which time the actions are moved to the block.
+      Actions_To_Be_Wrapped : Scope_Actions;
+      --  Actions that have to be inserted at the start, at the end, or as
+      --  cleanup actions of a transient block. Used to temporarily hold these
+      --  actions until the block is created, at which time the actions are
+      --  moved to the block.
 
       Pending_Freeze_Actions : List_Id;
       --  Used to collect freeze entity nodes and associated actions that are
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index f36c500..3f95221 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -602,6 +602,16 @@ package body Sem_Aux is
       return Empty;
    end Get_Rep_Pragma;
 
+   ---------------------------------
+   -- Has_External_Tag_Rep_Clause --
+   ---------------------------------
+
+   function Has_External_Tag_Rep_Clause (T : Entity_Id) return Boolean is
+   begin
+      pragma Assert (Is_Tagged_Type (T));
+      return Has_Rep_Item (T, Name_External_Tag, Check_Parents => False);
+   end Has_External_Tag_Rep_Clause;
+
    ------------------
    -- Has_Rep_Item --
    ------------------
diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index d394d09..cf722b2 100644
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.ads
@@ -251,6 +251,11 @@ package Sem_Aux is
    --  the given names then True is returned, otherwise False indicates that no
    --  matching entry was found.
 
+   function Has_External_Tag_Rep_Clause (T : Entity_Id) return Boolean;
+   --  Defined in tagged types. Set if an External_Tag rep. clause has been
+   --  given for this type. Use to avoid the generation of the default
+   --  External_Tag.
+
    function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
    --  True if T has discriminants and is unconstrained, or is an array type
    --  whose element type Has_Unconstrained_Elements.
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7245306..f9bf2a3 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -4353,9 +4353,7 @@ package body Sem_Ch13 is
                     ("static string required for tag name!", Nam);
                end if;
 
-               if VM_Target = No_VM then
-                  Set_Has_External_Tag_Rep_Clause (U_Ent);
-               else
+               if VM_Target /= No_VM then
                   Error_Msg_Name_1 := Attr;
                   Error_Msg_N
                     ("% attribute unsupported in this configuration", Nam);
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 43cd4fd..fb69ac6 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7541,10 +7541,7 @@ package body Sem_Ch8 is
       --  this case (and we do the abort even with assertions off since the
       --  penalty is incorrect code generation).
 
-      if SST.Actions_To_Be_Wrapped_Before /= No_List
-           or else
-         SST.Actions_To_Be_Wrapped_After  /= No_List
-      then
+      if SST.Actions_To_Be_Wrapped /= Scope_Actions'(others => No_List) then
          raise Program_Error;
       end if;
 
@@ -7611,8 +7608,7 @@ package body Sem_Ch8 is
          SST.Is_Transient                   := False;
          SST.Node_To_Be_Wrapped             := Empty;
          SST.Pending_Freeze_Actions         := No_List;
-         SST.Actions_To_Be_Wrapped_Before   := No_List;
-         SST.Actions_To_Be_Wrapped_After    := No_List;
+         SST.Actions_To_Be_Wrapped          := (others => No_List);
          SST.First_Use_Clause               := Empty;
          SST.Is_Active_Stack_Base           := False;
          SST.Previous_Visibility            := False;
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 5576cec..d2a19e2 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -432,6 +432,14 @@ package body Sinfo is
       return Node3 (N);
    end Classifications;
 
+   function Cleanup_Actions
+     (N : Node_Id) return List_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      return List5 (N);
+   end Cleanup_Actions;
+
    function Comes_From_Extended_Return_Statement
      (N : Node_Id) return Boolean is
    begin
@@ -3599,6 +3607,14 @@ package body Sinfo is
       Set_Node3 (N, Val); -- semantic field, no parent set
    end Set_Classifications;
 
+   procedure Set_Cleanup_Actions
+      (N : Node_Id; Val : List_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      Set_List5 (N, Val); -- semantic field, no parent set
+   end Set_Cleanup_Actions;
+
    procedure Set_Comes_From_Extended_Return_Statement
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index be0e649..4c28213 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -832,6 +832,10 @@ package Sinfo is
    --    the secondary stack and thus the result is passed by reference rather
    --    than copied another time.
 
+   --  Cleanup_Actions (List5-Sem)
+   --    Present in block statements created for transient blocks, contains
+   --    additional cleanup actions carried over from the transient scope.
+
    --  Check_Address_Alignment (Flag11-Sem)
    --    A flag present in N_Attribute_Definition clause for a 'Address
    --    attribute definition. This flag is set if a dynamic check should be
@@ -4731,6 +4735,7 @@ package Sinfo is
       --  Identifier (Node1) block direct name (set to Empty if not present)
       --  Declarations (List2) (set to No_List if no DECLARE part)
       --  Handled_Statement_Sequence (Node4)
+      --  Cleanup_Actions (List5-Sem)
       --  Is_Task_Master (Flag5-Sem)
       --  Activation_Chain_Entity (Node3-Sem)
       --  Has_Created_Identifier (Flag15)
@@ -8689,6 +8694,9 @@ package Sinfo is
    function Classifications
      (N : Node_Id) return Node_Id;    -- Node3
 
+   function Cleanup_Actions
+     (N : Node_Id) return List_Id;    -- List5
+
    function Comes_From_Extended_Return_Statement
      (N : Node_Id) return Boolean;    -- Flag18
 
@@ -9696,6 +9704,9 @@ package Sinfo is
    procedure Set_Classifications
      (N : Node_Id; Val : Node_Id);            -- Node3
 
+   procedure Set_Cleanup_Actions
+     (N : Node_Id; Val : List_Id);            -- List5
+
    procedure Set_Comes_From_Extended_Return_Statement
      (N : Node_Id; Val : Boolean := True);    -- Flag18
 
@@ -12369,6 +12380,7 @@ package Sinfo is
    pragma Inline (Choices);
    pragma Inline (Class_Present);
    pragma Inline (Classifications);
+   pragma Inline (Cleanup_Actions);
    pragma Inline (Comes_From_Extended_Return_Statement);
    pragma Inline (Compile_Time_Known_Aggregate);
    pragma Inline (Component_Associations);
@@ -12702,6 +12714,7 @@ package Sinfo is
    pragma Inline (Set_Choices);
    pragma Inline (Set_Class_Present);
    pragma Inline (Set_Classifications);
+   pragma Inline (Set_Cleanup_Actions);
    pragma Inline (Set_Comes_From_Extended_Return_Statement);
    pragma Inline (Set_Compile_Time_Known_Aggregate);
    pragma Inline (Set_Component_Associations);