[multiple changes]

2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb Flag252 is now used as Is_Finalized_Transient. Flag295
	is now used as Is_Ignored_Transient.
	(Is_Finalized_Transient): New routine.
	(Is_Ignored_Transient): New routine.
	(Is_Processed_Transient): Removed.
	(Set_Is_Finalized_Transient): New routine.
	(Set_Is_Ignored_Transient): New routine.
	(Set_Is_Processed_Transient): Removed.
	(Write_Entity_Flags): Output Flag252 and Flag295.
	* einfo.ads: New attributes Is_Finalized_Transient
	and Is_Ignored_Transient along with occurrences in
	entities. Remove attribute Is_Processed_Transient.
	(Is_Finalized_Transient): New routine along with pragma Inline.
	(Is_Ignored_Transient): New routine along with pragma Inline.
	(Is_Processed_Transient): Removed along with pragma Inline.
	(Set_Is_Finalized_Transient): New routine along with pragma Inline.
	(Set_Is_Ignored_Transient): New routine along with pragma Inline.
	(Set_Is_Processed_Transient): Removed along with pragma Inline.
	* exp_aggr.adb Add with and use clauses for Exp_Ch11 and Inline.
	(Build_Record_Aggr_Code): Change the handling
	of controlled record components.
	(Ctrl_Init_Expression): Removed.
	(Gen_Assign): Add new formal parameter In_Loop
	along with comment on usage.  Remove local variables Stmt and
	Stmt_Expr. Change the handling of controlled array components.
	(Gen_Loop): Update the call to Gen_Assign.
	(Gen_While): Update the call to Gen_Assign.
	(Initialize_Array_Component): New routine.
	(Initialize_Ctrl_Array_Component): New routine.
	(Initialize_Ctrl_Record_Component): New routine.
	(Initialize_Record_Component): New routine.
	(Process_Transient_Component): New routine.
	(Process_Transient_Component_Completion): New routine.
	* exp_ch4.adb (Process_Transient_In_Expression): New routine.
	(Process_Transient_Object): Removed. Replace all existing calls
	to this routine with calls to Process_Transient_In_Expression.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Remove local constant
	Is_Elem_Ref. Update the comment on ignoring transients.
	* exp_ch7.adb (Process_Declarations): Do not process ignored
	or finalized transient objects.
	(Process_Transient_In_Scope): New routine.
	(Process_Transients_In_Scope): New routine.
	(Process_Transient_Objects): Removed. Replace all existing calls
	to this routine with calls to Process_Transients_In_Scope.
	* exp_util.adb (Build_Transient_Object_Statements): New routine.
	(Is_Finalizable_Transient): Do not consider a transient object
	which has been finalized.
	(Requires_Cleanup_Actions): Do not consider ignored or finalized
	transient objects.
	* exp_util.ads (Build_Transient_Object_Statements): New routine.
	* sem_aggr.adb: Major code clean up.
	* sem_res.adb: Update documentation.

2016-07-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Subtype_Declaration): For generated
	subtypes, such as actual subtypes of unconstrained formals,
	inherit predicate functions, if any, from the parent type rather
	than creating redundant new ones.

From-SVN: r238044

gcc/ada/ChangeLog

 2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* einfo.adb Flag252 is now used as Is_Finalized_Transient. Flag295
+	is now used as Is_Ignored_Transient.
+	(Is_Finalized_Transient): New routine.
+	(Is_Ignored_Transient): New routine.
+	(Is_Processed_Transient): Removed.
+	(Set_Is_Finalized_Transient): New routine.
+	(Set_Is_Ignored_Transient): New routine.
+	(Set_Is_Processed_Transient): Removed.
+	(Write_Entity_Flags): Output Flag252 and Flag295.
+	* einfo.ads: New attributes Is_Finalized_Transient
+	and Is_Ignored_Transient along with occurrences in
+	entities. Remove attribute Is_Processed_Transient.
+	(Is_Finalized_Transient): New routine along with pragma Inline.
+	(Is_Ignored_Transient): New routine along with pragma Inline.
+	(Is_Processed_Transient): Removed along with pragma Inline.
+	(Set_Is_Finalized_Transient): New routine along with pragma Inline.
+	(Set_Is_Ignored_Transient): New routine along with pragma Inline.
+	(Set_Is_Processed_Transient): Removed along with pragma Inline.
+	* exp_aggr.adb Add with and use clauses for Exp_Ch11 and Inline.
+	(Build_Record_Aggr_Code): Change the handling
+	of controlled record components.
+	(Ctrl_Init_Expression): Removed.
+	(Gen_Assign): Add new formal parameter In_Loop
+	along with comment on usage.  Remove local variables Stmt and
+	Stmt_Expr. Change the handling of controlled array components.
+	(Gen_Loop): Update the call to Gen_Assign.
+	(Gen_While): Update the call to Gen_Assign.
+	(Initialize_Array_Component): New routine.
+	(Initialize_Ctrl_Array_Component): New routine.
+	(Initialize_Ctrl_Record_Component): New routine.
+	(Initialize_Record_Component): New routine.
+	(Process_Transient_Component): New routine.
+	(Process_Transient_Component_Completion): New routine.
+	* exp_ch4.adb (Process_Transient_In_Expression): New routine.
+	(Process_Transient_Object): Removed. Replace all existing calls
+	to this routine with calls to Process_Transient_In_Expression.
+	* exp_ch6.adb (Expand_Ctrl_Function_Call): Remove local constant
+	Is_Elem_Ref. Update the comment on ignoring transients.
+	* exp_ch7.adb (Process_Declarations): Do not process ignored
+	or finalized transient objects.
+	(Process_Transient_In_Scope): New routine.
+	(Process_Transients_In_Scope): New routine.
+	(Process_Transient_Objects): Removed. Replace all existing calls
+	to this routine with calls to Process_Transients_In_Scope.
+	* exp_util.adb (Build_Transient_Object_Statements): New routine.
+	(Is_Finalizable_Transient): Do not consider a transient object
+	which has been finalized.
+	(Requires_Cleanup_Actions): Do not consider ignored or finalized
+	transient objects.
+	* exp_util.ads (Build_Transient_Object_Statements): New routine.
+	* sem_aggr.adb: Major code clean up.
+	* sem_res.adb: Update documentation.
+
+2016-07-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Analyze_Subtype_Declaration): For generated
+	subtypes, such as actual subtypes of unconstrained formals,
+	inherit predicate functions, if any, from the parent type rather
+	than creating redundant new ones.
+
+2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting.
 
 2016-07-06  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/einfo.adb

@@ -561,7 +561,7 @@ package body Einfo is
    --    Has_Predicates                  Flag250
 
    --    Has_Implicit_Dereference        Flag251
-   --    Is_Processed_Transient          Flag252
+   --    Is_Finalized_Transient          Flag252
    --    Disable_Controlled              Flag253
    --    Is_Implementation_Defined       Flag254
    --    Is_Predicate_Function           Flag255
@@ -609,8 +609,8 @@ package body Einfo is
    --    Is_Partial_Invariant_Procedure  Flag292
    --    Is_Actual_Subtype               Flag293
    --    Has_Pragma_Unused               Flag294
+   --    Is_Ignored_Transient            Flag295
 
-   --    (unused)                        Flag295
    --    (unused)                        Flag296
    --    (unused)                        Flag297
    --    (unused)                        Flag298
@@ -2185,6 +2185,12 @@ package body Einfo is
       return Flag99 (Id);
    end Is_Exported;
 
+   function Is_Finalized_Transient (Id : E) return B is
+   begin
+      pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
+      return Flag252 (Id);
+   end Is_Finalized_Transient;
+
    function Is_First_Subtype (Id : E) return B is
    begin
       return Flag70 (Id);
@@ -2250,6 +2256,12 @@ package body Einfo is
       return Flag278 (Id);
    end Is_Ignored_Ghost_Entity;
 
+   function Is_Ignored_Transient (Id : E) return B is
+   begin
+      pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
+      return Flag295 (Id);
+   end Is_Ignored_Transient;
+
    function Is_Immediately_Visible (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -2466,12 +2478,6 @@ package body Einfo is
       return Flag245 (Id);
    end Is_Private_Primitive;
 
-   function Is_Processed_Transient (Id : E) return B is
-   begin
-      pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
-      return Flag252 (Id);
-   end Is_Processed_Transient;
-
    function Is_Public (Id : E) return B is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -5248,6 +5254,12 @@ package body Einfo is
       Set_Flag99 (Id, V);
    end Set_Is_Exported;
 
+   procedure Set_Is_Finalized_Transient (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
+      Set_Flag252 (Id, V);
+   end Set_Is_Finalized_Transient;
+
    procedure Set_Is_First_Subtype (Id : E; V : B := True) is
    begin
       Set_Flag70 (Id, V);
@@ -5329,6 +5341,12 @@ package body Einfo is
       Set_Flag278 (Id, V);
    end Set_Is_Ignored_Ghost_Entity;
 
+   procedure Set_Is_Ignored_Transient (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
+      Set_Flag295 (Id, V);
+   end Set_Is_Ignored_Transient;
+
    procedure Set_Is_Immediately_Visible (Id : E; V : B := True) is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -5543,12 +5561,6 @@ package body Einfo is
       Set_Flag245 (Id, V);
    end Set_Is_Private_Primitive;
 
-   procedure Set_Is_Processed_Transient (Id : E; V : B := True) is
-   begin
-      pragma Assert (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable));
-      Set_Flag252 (Id, V);
-   end Set_Is_Processed_Transient;
-
    procedure Set_Is_Public (Id : E; V : B := True) is
    begin
       pragma Assert (Nkind (Id) in N_Entity);
@@ -9241,6 +9253,7 @@ package body Einfo is
       W ("Is_Entry_Formal",                 Flag52  (Id));
       W ("Is_Exception_Handler",            Flag286 (Id));
       W ("Is_Exported",                     Flag99  (Id));
+      W ("Is_Finalized_Transient",          Flag252 (Id));
       W ("Is_First_Subtype",                Flag70  (Id));
       W ("Is_For_Access_Subtype",           Flag118 (Id));
       W ("Is_Formal_Subprogram",            Flag111 (Id));
@@ -9253,6 +9266,7 @@ package body Einfo is
       W ("Is_Hidden_Non_Overridden_Subpgm", Flag2   (Id));
       W ("Is_Hidden_Open_Scope",            Flag171 (Id));
       W ("Is_Ignored_Ghost_Entity",         Flag278 (Id));
+      W ("Is_Ignored_Transient",            Flag295 (Id));
       W ("Is_Immediately_Visible",          Flag7   (Id));
       W ("Is_Implementation_Defined",       Flag254 (Id));
       W ("Is_Imported",                     Flag24  (Id));
@@ -9292,7 +9306,6 @@ package body Einfo is
       W ("Is_Private_Composite",            Flag107 (Id));
       W ("Is_Private_Descendant",           Flag53  (Id));
       W ("Is_Private_Primitive",            Flag245 (Id));
-      W ("Is_Processed_Transient",          Flag252 (Id));
       W ("Is_Public",                       Flag10  (Id));
       W ("Is_Pure",                         Flag44  (Id));
       W ("Is_Pure_Unit_Access_Type",        Flag189 (Id));

gcc/ada/einfo.ads

@@ -535,7 +535,7 @@ package Einfo is
 --       a build-in-place function call. Contains the relocated build-in-place
 --       call after the expansion has decoupled the call from the object. This
 --       attribute is used by the finalization machinery to insert cleanup code
---       for all additional transient variables found in the transient block.
+--       for all additional transient objects found in the transient block.
 
 --    C_Pass_By_Copy (Flag125) [implementation base type only]
 --       Defined in record types. Set if a pragma Convention for the record
@@ -2484,6 +2484,12 @@ package Einfo is
 --       Applies to all entities, true for abstract states that are subject to
 --       option External.
 
+--    Is_Finalized_Transient (Flag252)
+--       Defined in constants, loop parameters of generalized iterators, and
+--       variables. Set when a transient object has been finalized by one of
+--       the transient finalization mechanisms. The flag prevents the double
+--       finalization of the object.
+
 --    Is_Finalizer (synthesized)
 --       Applies to all entities, true for procedures containing finalization
 --       code to process local or library level objects.
@@ -2595,6 +2601,13 @@ package Einfo is
 --       pragma Ghost or inherit "ghostness" from an enclosing construct, and
 --       subject to Assertion_Policy Ghost => Ignore.
 
+--    Is_Ignored_Transient (Flag295)
+--       Defined in constants, loop parameters of generalized iterators, and
+--       variables. Set when a transient object must be processed by one of
+--       the transient finalization mechanisms. Once marked, a transient is
+--       intentionally ignored by the general finalization mechanism because
+--       its clean up actions are context specific.
+
 --    Is_Immediately_Visible (Flag7)
 --       Defined in all entities. Set if entity is immediately visible, i.e.
 --       is defined in some currently open scope (RM 8.3(4)).
@@ -2997,13 +3010,6 @@ package Einfo is
 --       Applies to all entities, true for private types and subtypes,
 --       as well as for record with private types as subtypes.
 
---    Is_Processed_Transient (Flag252)
---       Defined in variables, loop parameters, and constants, including the
---       loop parameters of generalized iterators. Set when a transient object
---       needs to be finalized and has already been processed by the transient
---       scope machinery. This flag signals the general finalization mechanism
---       to ignore the transient object.
-
 --    Is_Protected_Component (synthesized)
 --       Applicable to all entities, true if the entity denotes a private
 --       component of a protected type.
@@ -5786,8 +5792,9 @@ package Einfo is
    --    Has_Volatile_Components             (Flag87)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
+   --    Is_Finalized_Transient              (Flag252)
+   --    Is_Ignored_Transient                (Flag295)
    --    Is_Independent                      (Flag268)
-   --    Is_Processed_Transient              (Flag252)  (constants only)
    --    Is_Return_Object                    (Flag209)
    --    Is_True_Constant                    (Flag163)
    --    Is_Uplevel_Referenced_Entity        (Flag283)
@@ -6552,8 +6559,9 @@ package Einfo is
    --    Has_Volatile_Components             (Flag87)
    --    Is_Atomic                           (Flag85)
    --    Is_Eliminated                       (Flag124)
+   --    Is_Finalized_Transient              (Flag252)
+   --    Is_Ignored_Transient                (Flag295)
    --    Is_Independent                      (Flag268)
-   --    Is_Processed_Transient              (Flag252)
    --    Is_Return_Object                    (Flag209)
    --    Is_Safe_To_Reevaluate               (Flag249)
    --    Is_Shared_Passive                   (Flag60)
@@ -7062,6 +7070,7 @@ package Einfo is
    function Is_Entry_Formal                     (Id : E) return B;
    function Is_Exception_Handler                (Id : E) return B;
    function Is_Exported                         (Id : E) return B;
+   function Is_Finalized_Transient              (Id : E) return B;
    function Is_First_Subtype                    (Id : E) return B;
    function Is_For_Access_Subtype               (Id : E) return B;
    function Is_Frozen                           (Id : E) return B;
@@ -7070,6 +7079,7 @@ package Einfo is
    function Is_Hidden_Non_Overridden_Subpgm     (Id : E) return B;
    function Is_Hidden_Open_Scope                (Id : E) return B;
    function Is_Ignored_Ghost_Entity             (Id : E) return B;
+   function Is_Ignored_Transient                (Id : E) return B;
    function Is_Immediately_Visible              (Id : E) return B;
    function Is_Implementation_Defined           (Id : E) return B;
    function Is_Imported                         (Id : E) return B;
@@ -7108,7 +7118,6 @@ package Einfo is
    function Is_Private_Composite                (Id : E) return B;
    function Is_Private_Descendant               (Id : E) return B;
    function Is_Private_Primitive                (Id : E) return B;
-   function Is_Processed_Transient              (Id : E) return B;
    function Is_Public                           (Id : E) return B;
    function Is_Pure                             (Id : E) return B;
    function Is_Pure_Unit_Access_Type            (Id : E) return B;
@@ -7736,6 +7745,7 @@ package Einfo is
    procedure Set_Is_Entry_Formal                 (Id : E; V : B := True);
    procedure Set_Is_Exception_Handler            (Id : E; V : B := True);
    procedure Set_Is_Exported                     (Id : E; V : B := True);
+   procedure Set_Is_Finalized_Transient          (Id : E; V : B := True);
    procedure Set_Is_First_Subtype                (Id : E; V : B := True);
    procedure Set_Is_For_Access_Subtype           (Id : E; V : B := True);
    procedure Set_Is_Formal_Subprogram            (Id : E; V : B := True);
@@ -7748,6 +7758,7 @@ package Einfo is
    procedure Set_Is_Hidden_Non_Overridden_Subpgm (Id : E; V : B := True);
    procedure Set_Is_Hidden_Open_Scope            (Id : E; V : B := True);
    procedure Set_Is_Ignored_Ghost_Entity         (Id : E; V : B := True);
+   procedure Set_Is_Ignored_Transient            (Id : E; V : B := True);
    procedure Set_Is_Immediately_Visible          (Id : E; V : B := True);
    procedure Set_Is_Implementation_Defined       (Id : E; V : B := True);
    procedure Set_Is_Imported                     (Id : E; V : B := True);
@@ -7787,7 +7798,6 @@ package Einfo is
    procedure Set_Is_Private_Composite            (Id : E; V : B := True);
    procedure Set_Is_Private_Descendant           (Id : E; V : B := True);
    procedure Set_Is_Private_Primitive            (Id : E; V : B := True);
-   procedure Set_Is_Processed_Transient          (Id : E; V : B := True);
    procedure Set_Is_Public                       (Id : E; V : B := True);
    procedure Set_Is_Pure                         (Id : E; V : B := True);
    procedure Set_Is_Pure_Unit_Access_Type        (Id : E; V : B := True);
@@ -8544,6 +8554,7 @@ package Einfo is
    pragma Inline (Is_Enumeration_Type);
    pragma Inline (Is_Exception_Handler);
    pragma Inline (Is_Exported);
+   pragma Inline (Is_Finalized_Transient);
    pragma Inline (Is_First_Subtype);
    pragma Inline (Is_Fixed_Point_Type);
    pragma Inline (Is_Floating_Point_Type);
@@ -8563,6 +8574,7 @@ package Einfo is
    pragma Inline (Is_Hidden_Non_Overridden_Subpgm);
    pragma Inline (Is_Hidden_Open_Scope);
    pragma Inline (Is_Ignored_Ghost_Entity);
+   pragma Inline (Is_Ignored_Transient);
    pragma Inline (Is_Immediately_Visible);
    pragma Inline (Is_Implementation_Defined);
    pragma Inline (Is_Imported);
@@ -8612,7 +8624,6 @@ package Einfo is
    pragma Inline (Is_Private_Descendant);
    pragma Inline (Is_Private_Primitive);
    pragma Inline (Is_Private_Type);
-   pragma Inline (Is_Processed_Transient);
    pragma Inline (Is_Protected_Type);
    pragma Inline (Is_Public);
    pragma Inline (Is_Pure);
@@ -9039,6 +9050,7 @@ package Einfo is
    pragma Inline (Set_Is_Entry_Formal);
    pragma Inline (Set_Is_Exception_Handler);
    pragma Inline (Set_Is_Exported);
+   pragma Inline (Set_Is_Finalized_Transient);
    pragma Inline (Set_Is_First_Subtype);
    pragma Inline (Set_Is_For_Access_Subtype);
    pragma Inline (Set_Is_Formal_Subprogram);
@@ -9051,6 +9063,7 @@ package Einfo is
    pragma Inline (Set_Is_Hidden_Non_Overridden_Subpgm);
    pragma Inline (Set_Is_Hidden_Open_Scope);
    pragma Inline (Set_Is_Ignored_Ghost_Entity);
+   pragma Inline (Set_Is_Ignored_Transient);
    pragma Inline (Set_Is_Immediately_Visible);
    pragma Inline (Set_Is_Implementation_Defined);
    pragma Inline (Set_Is_Imported);
@@ -9090,7 +9103,6 @@ package Einfo is
    pragma Inline (Set_Is_Private_Composite);
    pragma Inline (Set_Is_Private_Descendant);
    pragma Inline (Set_Is_Private_Primitive);
-   pragma Inline (Set_Is_Processed_Transient);
    pragma Inline (Set_Is_Public);
    pragma Inline (Set_Is_Pure);
    pragma Inline (Set_Is_Pure_Unit_Access_Type);

gcc/ada/exp_ch6.adb

@@ -4115,10 +4115,6 @@ package body Exp_Ch6 is
              and then Present (Generalized_Indexing (Ref));
       end Is_Element_Reference;
 
-      --  Local variables
-
-      Is_Elem_Ref : constant Boolean := Is_Element_Reference (N);
-
    --  Start of processing for Expand_Ctrl_Function_Call
 
    begin
@@ -4142,20 +4138,24 @@ package body Exp_Ch6 is
 
       Remove_Side_Effects (N);
 
-      --  When the temporary function result appears inside a case expression
-      --  or an if expression, its lifetime must be extended to match that of
-      --  the context. If not, the function result will be finalized too early
-      --  and the evaluation of the expression could yield incorrect result. An
-      --  exception to this rule are references to Ada 2012 container elements.
+      --  The side effect removal of the function call produced a temporary.
+      --  When the context is a case expression, if expression, or expression
+      --  with actions, the lifetime of the temporary must be extended to match
+      --  that of the context. Otherwise the function result will be finalized
+      --  too early and affect the result of the expression. To prevent this
+      --  unwanted effect, the temporary should not be considered for clean up
+      --  actions by the general finalization machinery.
+
+      --  Exception to this rule are references to Ada 2012 container elements.
       --  Such references must be finalized at the end of each iteration of the
       --  related quantified expression, otherwise the container will remain
       --  busy.
 
-      if not Is_Elem_Ref
+      if Nkind (N) = N_Explicit_Dereference
         and then Within_Case_Or_If_Expression (N)
-        and then Nkind (N) = N_Explicit_Dereference
+        and then not Is_Element_Reference (N)
       then
-         Set_Is_Processed_Transient (Entity (Prefix (N)));
+         Set_Is_Ignored_Transient (Entity (Prefix (N)));
       end if;
    end Expand_Ctrl_Function_Call;
 

gcc/ada/exp_util.adb

@@ -1653,6 +1653,133 @@ package body Exp_Util is
       return Build_Task_Image_Function (Loc, Decls, Stats, Res);
    end Build_Task_Record_Image;
 
+   ---------------------------------------
+   -- Build_Transient_Object_Statements --
+   ---------------------------------------
+
+   procedure Build_Transient_Object_Statements
+     (Obj_Decl     : Node_Id;
+      Fin_Call     : out Node_Id;
+      Hook_Assign  : out Node_Id;
+      Hook_Clear   : out Node_Id;
+      Hook_Decl    : out Node_Id;
+      Ptr_Decl     : out Node_Id;
+      Finalize_Obj : Boolean := True)
+   is
+      Loc     : constant Source_Ptr := Sloc (Obj_Decl);
+      Obj_Id  : constant Entity_Id  := Defining_Entity (Obj_Decl);
+      Obj_Typ : constant Entity_Id  := Base_Type (Etype (Obj_Id));
+
+      Desig_Typ : Entity_Id;
+      Hook_Expr : Node_Id;
+      Hook_Id   : Entity_Id;
+      Obj_Ref   : Node_Id;
+      Ptr_Typ   : Entity_Id;
+
+   begin
+      --  Recover the type of the object
+
+      Desig_Typ := Obj_Typ;
+
+      if Is_Access_Type (Desig_Typ) then
+         Desig_Typ := Available_View (Designated_Type (Desig_Typ));
+      end if;
+
+      --  Create an access type which provides a reference to the transient
+      --  object. Generate:
+
+      --    type Ptr_Typ is access all Desig_Typ;
+
+      Ptr_Typ := Make_Temporary (Loc, 'A');
+      Set_Ekind (Ptr_Typ, E_General_Access_Type);
+      Set_Directly_Designated_Type (Ptr_Typ, Desig_Typ);
+
+      Ptr_Decl :=
+        Make_Full_Type_Declaration (Loc,
+          Defining_Identifier => Ptr_Typ,
+          Type_Definition     =>
+            Make_Access_To_Object_Definition (Loc,
+              All_Present        => True,
+              Subtype_Indication => New_Occurrence_Of (Desig_Typ, Loc)));
+
+      --  Create a temporary check which acts as a hook to the transient
+      --  object. Generate:
+
+      --    Hook : Ptr_Typ := null;
+
+      Hook_Id := Make_Temporary (Loc, 'T');
+      Set_Ekind (Hook_Id, E_Variable);
+      Set_Etype (Hook_Id, Ptr_Typ);
+
+      Hook_Decl :=
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Hook_Id,
+          Object_Definition   => New_Occurrence_Of (Ptr_Typ, Loc),
+          Expression          => Make_Null (Loc));
+
+      --  Mark the temporary as a hook. This signals the machinery in
+      --  Build_Finalizer to recognize this special case.
+
+      Set_Status_Flag_Or_Transient_Decl (Hook_Id, Obj_Decl);
+
+      --  Hook the transient object to the temporary. Generate:
+
+      --    Hook := Ptr_Typ (Obj_Id);
+      --      <or>
+      --    Hool := Obj_Id'Unrestricted_Access;
+
+      if Is_Access_Type (Obj_Typ) then
+         Hook_Expr :=
+           Unchecked_Convert_To (Ptr_Typ, New_Occurrence_Of (Obj_Id, Loc));
+      else
+         Hook_Expr :=
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Occurrence_Of (Obj_Id, Loc),
+             Attribute_Name => Name_Unrestricted_Access);
+      end if;
+
+      Hook_Assign :=
+        Make_Assignment_Statement (Loc,
+          Name       => New_Occurrence_Of (Hook_Id, Loc),
+          Expression => Hook_Expr);
+
+      --  Crear the hook prior to finalizing the object. Generate:
+
+      --    Hook := null;
+
+      Hook_Clear :=
+        Make_Assignment_Statement (Loc,
+          Name       => New_Occurrence_Of (Hook_Id, Loc),
+          Expression => Make_Null (Loc));
+
+      --  Finalize the object. Generate:
+
+      --    [Deep_]Finalize (Obj_Ref[.all]);
+
+      if Finalize_Obj then
+         Obj_Ref := New_Occurrence_Of (Obj_Id, Loc);
+
+         if Is_Access_Type (Obj_Typ) then
+            Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
+            Set_Etype (Obj_Ref, Desig_Typ);
+         end if;
+
+         Fin_Call := Make_Final_Call (Obj_Ref, Desig_Typ);
+
+      --  Otherwise finalize the hook. Generate:
+
+      --    [Deep_]Finalize (Hook.all);
+
+      else
+         Fin_Call :=
+           Make_Final_Call (
+             Obj_Ref =>
+               Make_Explicit_Dereference (Loc,
+                 Prefix => New_Occurrence_Of (Hook_Id, Loc)),
+             Typ     => Desig_Typ);
+      end if;
+   end Build_Transient_Object_Statements;
+
    -----------------------------
    -- Check_Float_Op_Overflow --
    -----------------------------
@@ -5067,7 +5194,7 @@ package body Exp_Util is
          --  explicit aliases of it:
 
          --    do
-         --       Trans_Id : Ctrl_Typ ...;  --  controlled transient object
+         --       Trans_Id : Ctrl_Typ ...;  --  transient object
          --       Alias : ... := Trans_Id;  --  object is aliased
          --       Val : constant Boolean :=
          --               ... Alias ...;    --  aliasing ends
@@ -5236,6 +5363,10 @@ package body Exp_Util is
           and then Requires_Transient_Scope (Desig)
           and then Nkind (Rel_Node) /= N_Simple_Return_Statement
 
+          --  Do not consider a transient object that was already processed
+
+          and then not Is_Finalized_Transient (Obj_Id)
+
           --  Do not consider renamed or 'reference-d transient objects because
           --  the act of renaming extends the object's lifetime.
 
@@ -8255,11 +8386,19 @@ package body Exp_Util is
             if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
                null;
 
-            --  Transient variables are treated separately in order to minimize
-            --  the size of the generated code. See Exp_Ch7.Process_Transient_
-            --  Objects.
+            --  Finalization of transient objects are treated separately in
+            --  order to handle sensitive cases. These include:
 
-            elsif Is_Processed_Transient (Obj_Id) then
+            --    * Aggregate expansion
+            --    * If, case, and expression with actions expansion
+            --    * Transient scopes
+
+            --  If one of those contexts has marked the transient object as
+            --  ignored, do not generate finalization actions for it.
+
+            elsif Is_Finalized_Transient (Obj_Id)
+              or else Is_Ignored_Transient (Obj_Id)
+            then
                null;
 
             --  Ignored Ghost objects do not need any cleanup actions because
@@ -8315,8 +8454,8 @@ package body Exp_Util is
             then
                return True;
 
-            --  Processing for "hook" objects generated for controlled
-            --  transients declared inside an Expression_With_Actions.
+            --  Processing for "hook" objects generated for transient objects
+            --  declared inside an Expression_With_Actions.
 
             elsif Is_Access_Type (Obj_Typ)
               and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
@@ -8464,7 +8603,7 @@ package body Exp_Util is
          elsif Nkind (Decl) = N_Block_Statement
            and then
 
-           --  Handle a rare case caused by a controlled transient variable
+           --  Handle a rare case caused by a controlled transient object
            --  created as part of a record init proc. The variable is wrapped
            --  in a block, but the block is not associated with a transient
            --  scope.

gcc/ada/exp_util.ads

@@ -280,6 +280,35 @@ package Exp_Util is
    --  is false, the call is for a stand-alone object, and the generated
    --  function itself must do its own cleanups.
 
+   procedure Build_Transient_Object_Statements
+     (Obj_Decl     : Node_Id;
+      Fin_Call     : out Node_Id;
+      Hook_Assign  : out Node_Id;
+      Hook_Clear   : out Node_Id;
+      Hook_Decl    : out Node_Id;
+      Ptr_Decl     : out Node_Id;
+      Finalize_Obj : Boolean := True);
+   --  Subsidiary to the processing of transient objects in transient scopes,
+   --  if expressions, case expressions, expression_with_action nodes, array
+   --  aggregates, and record aggregates. Obj_Decl denotes the declaration of
+   --  the transient object. Generate the following nodes:
+   --
+   --    * Fin_Call - the call to [Deep_]Finalize which cleans up the transient
+   --    object if flag Finalize_Obj is set to True, or finalizes the hook when
+   --    the flag is False.
+   --
+   --    * Hook_Assign - the assignment statement which captures a reference to
+   --    the transient object in the hook.
+   --
+   --    * Hook_Clear - the assignment statement which resets the hook to null
+   --
+   --    * Hook_Decl - the declaration of the hook object
+   --
+   --    * Ptr_Decl - the full type declaration of the hook type
+   --
+   --  These nodes are inserted in specific places depending on the context by
+   --  the various Process_Transient_xxx routines.
+
    procedure Check_Float_Op_Overflow (N : Node_Id);
    --  Called where we could have a floating-point binary operator where we
    --  must check for infinities if we are operating in Check_Float_Overflow

gcc/ada/sem_ch3.adb

@@ -4802,6 +4802,24 @@ package body Sem_Ch3 is
       then
          Set_Has_Predicates (Id);
          Set_Has_Delayed_Freeze (Id);
+
+         --  Generated subtypes inherit the predicate function from the parent
+         --  (no aspects to examine on the generated declaration).
+
+         if not Comes_From_Source (N) then
+            Set_Ekind (Id, Ekind (T));
+
+            if Present (Predicate_Function (T)) then
+               Set_Predicate_Function (Id, Predicate_Function (T));
+
+            elsif Present (Ancestor_Subtype (T))
+              and then Has_Predicates (Ancestor_Subtype (T))
+              and then Present (Predicate_Function (Ancestor_Subtype (T)))
+            then
+               Set_Predicate_Function (Id,
+                 Predicate_Function (Ancestor_Subtype (T)));
+            end if;
+         end if;
       end if;
 
       --  Subtype of Boolean cannot have a constraint in SPARK

gcc/ada/sem_res.adb

@@ -9951,10 +9951,10 @@ package body Sem_Res is
 
    begin
       --  Ensure all actions associated with the left operand (e.g.
-      --  finalization of transient controlled objects) are fully evaluated
-      --  locally within an expression with actions. This is particularly
-      --  helpful for coverage analysis. However this should not happen in
-      --  generics or if Minimize_Expression_With_Actions is set.
+      --  finalization of transient objects) are fully evaluated locally within
+      --  an expression with actions. This is particularly helpful for coverage
+      --  analysis. However this should not happen in generics or if option
+      --  Minimize_Expression_With_Actions is set.
 
       if Expander_Active and not Minimize_Expression_With_Actions then
          declare