-- Local variables
- Parent_Kind : Node_Kind;
Parent_Node : Node_Id;
-- Start of processing for In_Place_Assign_OK
end if;
Parent_Node := Parent (N);
- Parent_Kind := Nkind (Parent_Node);
- if Parent_Kind = N_Qualified_Expression then
+ if Nkind (Parent_Node) = N_Qualified_Expression then
Parent_Node := Parent (Parent_Node);
- Parent_Kind := Nkind (Parent_Node);
end if;
-- On assignment, sliding can take place, so we cannot do the
procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
- function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean;
- -- Decl is an N_Object_Declaration node. Return true if it declares an
- -- object with a known size; in this context, that is always the case,
- -- except for a declaration without explicit constraints of an object,
- -- either whose nominal subtype is class-wide, or whose initialization
- -- contains a conditional expression and whose nominal subtype is both
- -- discriminated and unconstrained.
-
- ----------------
- -- Known_Size --
- ----------------
-
- function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean
- is
- begin
- if Is_Entity_Name (Object_Definition (Decl)) then
- declare
- Typ : constant Entity_Id := Entity (Object_Definition (Decl));
-
- begin
- return not Is_Class_Wide_Type (Typ)
- and then not (Cond_Init
- and then Has_Discriminants (Typ)
- and then not Is_Constrained (Typ));
- end;
-
- else
- return True;
- end if;
- end Known_Size;
-
-- Local variables
Aggr_Code : List_Id;
Full_Typ : Entity_Id;
- In_Cond_Expr : Boolean;
Instr : Node_Id;
- Node : Node_Id;
Parent_Node : Node_Id;
Target_Expr : Node_Id;
Temp : Entity_Id;
pragma Assert (not Is_Static_Dispatch_Table_Aggregate (N));
pragma Assert (Is_Record_Type (Typ));
- In_Cond_Expr := False;
- Node := N;
- Parent_Node := Parent (Node);
-
- -- First, climb the parent chain, looking through qualified expressions
- -- and dependent expressions of conditional expressions.
-
- loop
- case Nkind (Parent_Node) is
- when N_Case_Expression_Alternative =>
- null;
-
- when N_Case_Expression =>
- exit when Node = Expression (Parent_Node);
- In_Cond_Expr := True;
-
- when N_If_Expression =>
- exit when Node = First (Expressions (Parent_Node));
- In_Cond_Expr := True;
-
- when N_Qualified_Expression =>
- null;
-
- when others =>
- exit;
- end case;
-
- Node := Parent_Node;
- Parent_Node := Parent (Node);
- end loop;
-
-- Set the Expansion_Delayed flag in the cases where the transformation
-- will be done top down from above.
+ Parent_Node := Unconditional_Parent (N);
+
if
-- Internal aggregates (transformed when expanding the parent),
-- excluding container aggregates as these are transformed into
or else Nkind (Parent_Node) = N_Allocator
- -- Object declaration (see Convert_Aggr_In_Object_Decl). So far only
- -- declarations with a known size are supported.
+ -- Object declaration (see Convert_Aggr_In_Object_Decl). Class-wide
+ -- declarations are excluded so far.
or else (Nkind (Parent_Node) = N_Object_Declaration
- and then Known_Size (Parent_Node, In_Cond_Expr))
+ and then not
+ (Is_Entity_Name (Object_Definition (Parent_Node))
+ and then
+ Is_Class_Wide_Type
+ (Entity (Object_Definition (Parent_Node)))))
-- Safe assignment (see Convert_Aggr_In_Assignment). So far only the
-- assignments in init procs are taken into account.
-- Holds the declaration of Tmp
Parent_Node : Node_Id;
- Parent_Kind : Node_Kind;
-- Start of processing for Expand_Array_Aggregate
-- Set the Expansion_Delayed flag in the cases where the transformation
-- will be done top down from above.
- Parent_Node := Parent (N);
- Parent_Kind := Nkind (Parent_Node);
-
- if Parent_Kind = N_Qualified_Expression then
- Parent_Node := Parent (Parent_Node);
- Parent_Kind := Nkind (Parent_Node);
- end if;
+ Parent_Node := Unconditional_Parent (N);
if
-- Internal aggregates (transformed when expanding the parent),
-- subprogram calls later. So far aggregates with self-references
-- are not supported if they appear in a conditional expression.
- (Parent_Kind = N_Component_Association
+ (Nkind (Parent_Node) = N_Component_Association
and then not Is_Container_Aggregate (Parent (Parent_Node)))
- or else (Parent_Kind in N_Aggregate | N_Extension_Aggregate
+ or else (Nkind (Parent_Node) in N_Aggregate | N_Extension_Aggregate
and then not Is_Container_Aggregate (Parent_Node))
-- Allocator (see Convert_Aggr_In_Allocator). Sliding cannot be done
-- Object declaration (see Convert_Aggr_In_Object_Decl). Sliding
-- cannot be done in place for the time being.
- or else (Parent_Kind = N_Object_Declaration
+ or else (Nkind (Parent_Node) = N_Object_Declaration
and then
(Aggr_Assignment_OK_For_Backend (N)
or else Is_Limited_Type (Typ)
-- assignments in init procs are taken into account, as well those
-- directly performed by the back end.
- or else (Parent_Kind = N_Assignment_Statement
+ or else (Nkind (Parent_Node) = N_Assignment_Statement
and then
(Inside_Init_Proc
or else
or else Is_Build_In_Place_Aggregate_Return (Parent_Node)
then
- Set_Expansion_Delayed (N, not Static_Array_Aggregate (N));
+ if not Static_Array_Aggregate (N) then
+ -- Mark the aggregate, as well as all the intermediate conditional
+ -- expressions, as having expansion delayed. This will block the
+ -- usual (bottom-up) expansion of the marked nodes and replace it
+ -- with a top-down expansion from the parent node.
+
+ Set_Expansion_Delayed (N);
+ Delay_Conditional_Expressions_Between (N, Parent_Node);
+ end if;
+
return;
end if;
Establish_Transient_Scope (N, Manage_Sec_Stack => False);
end if;
+ -- Now get back to the immediate parent, modulo qualified expression
+
+ Parent_Node := Parent (N);
+
+ if Nkind (Parent_Node) = N_Qualified_Expression then
+ Parent_Node := Parent (Parent_Node);
+ end if;
+
-- STEP 5
-- Check whether in-place aggregate expansion is possible
-- protected objects or tasks. For other cases we create a temporary.
Maybe_In_Place_OK :=
- Parent_Kind = N_Assignment_Statement
+ Nkind (Parent_Node) = N_Assignment_Statement
and then (Is_Limited_Type (Typ)
or else (not Has_Default_Init_Comps (N)
and then not Is_Bit_Packed_Array (Typ)
-- around the aggregate for this purpose.
if Ekind (Current_Scope) = E_Loop
- and then Parent_Kind = N_Allocator
+ and then Nkind (Parent_Node) = N_Allocator
then
Establish_Transient_Scope (N, Manage_Sec_Stack => False);
-- If the parent is an assignment for which no controlled actions
-- should take place, prevent the temporary from being finalized.
- elsif Parent_Kind = N_Assignment_Statement
+ elsif Nkind (Parent_Node) = N_Assignment_Statement
and then No_Ctrl_Actions (Parent_Node)
then
Mutate_Ekind (Tmp, E_Variable);
-- Return the size of a small signed integer type covering Lo .. Hi, the
-- main goal being to return a size lower than that of standard types.
+ procedure Insert_Conditional_Object_Declaration
+ (Obj_Id : Entity_Id;
+ Expr : Node_Id;
+ Decl : Node_Id);
+ -- Expr is the dependent expression of a conditional expression and Decl
+ -- is the declaration of an object whose initialization expression is the
+ -- conditional expression. Insert in the actions of Expr the declaration
+ -- of Obj_Id modeled on Decl and with Expr as initialization expression.
+
procedure Insert_Dereference_Action (N : Node_Id);
-- N is an expression whose type is an access. When the type of the
-- associated storage pool is derived from Checked_Pool, generate a
function Size_In_Storage_Elements (E : Entity_Id) return Node_Id is
Idx : Node_Id := First_Index (E);
- Len : Node_Id;
+ Len : Node_Id := Empty;
Res : Node_Id := Empty;
begin
-- Return True if we can copy objects of this type when expanding a case
-- expression.
+ function Is_Optimizable_Declaration (N : Node_Id) return Boolean;
+ -- Return True if N is an object declaration that can be optimized
+
------------------
-- Is_Copy_Type --
------------------
return Is_Elementary_Type (Underlying_Type (Typ));
end Is_Copy_Type;
+ --------------------------------
+ -- Is_Optimizable_Declaration --
+ --------------------------------
+
+ function Is_Optimizable_Declaration (N : Node_Id) return Boolean is
+ begin
+ return Nkind (N) = N_Object_Declaration
+ and then not (Is_Entity_Name (Object_Definition (N))
+ and then Is_Class_Wide_Type
+ (Entity (Object_Definition (N))))
+ and then not Is_Return_Object (Defining_Identifier (N))
+ and then not Is_Copy_Type (Typ);
+ end Is_Optimizable_Declaration;
+
-- Local variables
Acts : List_Id;
Alt : Node_Id;
Case_Stmt : Node_Id;
Decl : Node_Id;
+ New_N : Node_Id;
+ Par_Obj : Node_Id;
Target : Entity_Id := Empty;
Target_Typ : Entity_Id;
-- This makes the expansion much easier when expressions are calls to
-- build-in-place functions.
+ Optimize_Object_Decl : Boolean := False;
+ -- Small optimization: when the case expression appears in the context
+ -- of an object declaration of a type not Is_Copy_Type, expand into
+
+ -- case X is
+ -- when A =>
+ -- then-obj : typ := then_expr;
+ -- target := then-obj'Unrestricted_Access;
+ -- when B =>
+ -- else-obj : typ := else-expr;
+ -- target := else-obj'Unrestricted_Access;
+ -- ...
+ -- end case
+ --
+ -- obj : typ renames target.all;
+
+ -- This makes the expansion much easier when expressions are calls to
+ -- build-in-place functions.
+
-- Start of processing for Expand_N_Case_Expression
begin
declare
Uncond_Par : constant Node_Id := Unconditional_Parent (N);
begin
- if Nkind (Uncond_Par) = N_Simple_Return_Statement then
+ if Nkind (Uncond_Par) = N_Simple_Return_Statement
+ or else Is_Optimizable_Declaration (Uncond_Par)
+ then
Delay_Conditional_Expressions_Between (N, Uncond_Par);
end if;
end;
elsif Nkind (Par) = N_Simple_Return_Statement then
Optimize_Return_Stmt := True;
+ elsif Is_Optimizable_Declaration (Par) then
+ Optimize_Object_Decl := True;
+
else
return;
end if;
-- No need for Target_Typ in the case of statements
if Optimize_Assignment_Stmt or else Optimize_Return_Stmt then
- null;
+ Target_Typ := Empty;
-- Scalar/Copy case
-- 'Unrestricted_Access.
-- Generate:
- -- type Ptr_Typ is not null access all Typ;
+ -- type Ptr_Typ is not null access all [constant] Typ;
else
Target_Typ := Make_Temporary (Loc, 'P');
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Null_Exclusion_Present => True,
- Subtype_Indication => New_Occurrence_Of (Typ, Loc))));
+ Subtype_Indication => New_Occurrence_Of (Typ, Loc),
+ Constant_Present =>
+ Optimize_Object_Decl and then Constant_Present (Par))));
end if;
-- Create the declaration of the target which captures the value of the
Alt := First (Alternatives (N));
while Present (Alt) loop
+ -- When the alternative's expression involves controlled function
+ -- calls, generated temporaries are chained on the corresponding
+ -- list of actions. These temporaries need to be finalized after
+ -- the case expression is evaluated.
+
+ Process_Transients_In_Expression (N, Actions (Alt));
+
declare
Alt_Loc : constant Source_Ptr := Sloc (Expression (Alt));
Alt_Expr : Node_Id := Relocate_Node (Expression (Alt));
LHS : Node_Id;
+ Obj : Node_Id;
Stmts : List_Id;
begin
Unanalyze_Delayed_Conditional_Expression (Alt_Expr);
end if;
+ -- Generate:
+ -- Obj : [constant] Typ := AX;
+ -- Target := Obj'Unrestricted_Access;
+
+ elsif Optimize_Object_Decl then
+ Obj := Make_Temporary (Loc, 'C', Alt_Expr);
+
+ Insert_Conditional_Object_Declaration (Obj, Alt_Expr, Par);
+
+ Alt_Expr :=
+ Make_Attribute_Reference (Alt_Loc,
+ Prefix => New_Occurrence_Of (Obj, Alt_Loc),
+ Attribute_Name => Name_Unrestricted_Access);
+
+ LHS := New_Occurrence_Of (Target, Loc);
+ Set_Assignment_OK (LHS);
+
+ Stmts := New_List (
+ Make_Assignment_Statement (Alt_Loc,
+ Name => LHS,
+ Expression => Alt_Expr));
+
-- Take the unrestricted access of the expression value for non-
-- scalar types. This approach avoids big copies and covers the
-- limited and unconstrained cases.
-- Generate:
- -- Target := AX['Unrestricted_Access];
+ -- Target := AX'Unrestricted_Access;
else
if not Is_Copy_Type (Typ) then
Make_Case_Statement_Alternative (Sloc (Alt),
Discrete_Choices => Discrete_Choices (Alt),
Statements => Stmts));
-
- -- Finalize any transient objects on exit from the alternative.
- -- Note that this needs to be done only after Stmts is attached
- -- to the Alternatives list above (for Safe_To_Capture_Value).
-
- Process_Transients_In_Expression (N, Stmts);
end;
Next (Alt);
Rewrite (Par, Case_Stmt);
Analyze (Par);
+ elsif Optimize_Object_Decl then
+ Append_To (Acts, Case_Stmt);
+ Insert_Actions (Par, Acts);
+
+ New_N :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Target, Loc));
+
+ -- The renaming is not analyzed so complete the decoration of the
+ -- object and set the type of the name directly.
+
+ Par_Obj := Defining_Identifier (Par);
+ if Constant_Present (Par) then
+ Mutate_Ekind (Par_Obj, E_Constant);
+ Set_Is_True_Constant (Par_Obj);
+ else
+ Mutate_Ekind (Par_Obj, E_Variable);
+ end if;
+
+ Set_Etype (New_N, Etype (Par_Obj));
+
+ Rewrite_Object_Declaration_As_Renaming (Par, New_N);
+
-- Otherwise rewrite the case expression itself
else
Append_To (Acts, Case_Stmt);
if Is_Copy_Type (Typ) then
- Rewrite (N,
+ New_N :=
Make_Expression_With_Actions (Loc,
Expression => New_Occurrence_Of (Target, Loc),
- Actions => Acts));
+ Actions => Acts);
else
Insert_Actions (N, Acts);
- Rewrite (N,
+ New_N :=
Make_Explicit_Dereference (Loc,
- Prefix => New_Occurrence_Of (Target, Loc)));
+ Prefix => New_Occurrence_Of (Target, Loc));
end if;
+ Rewrite (N, New_N);
Analyze_And_Resolve (N, Typ);
end if;
end Expand_N_Case_Expression;
-- actions in order to create a temporary to capture the level of the
-- expression in each branch.
+ function Is_Copy_Type (Typ : Entity_Id) return Boolean;
+ -- Return True if we can copy objects of this type when expanding an if
+ -- expression.
+
+ function Is_Optimizable_Declaration (N : Node_Id) return Boolean;
+ -- Return True if N is an object declaration that can be optimized
+
function OK_For_Single_Subtype (T1, T2 : Entity_Id) return Boolean;
-- Return true if it is acceptable to use a single subtype for two
-- dependent expressions of subtype T1 and T2 respectively, which are
-- unidimensional arrays whose index bounds are known at compile time.
+ ------------------
+ -- Is_Copy_Type --
+ ------------------
+
+ function Is_Copy_Type (Typ : Entity_Id) return Boolean is
+ Utyp : constant Entity_Id := Underlying_Type (Typ);
+
+ begin
+ return Is_Definite_Subtype (Utyp)
+ and then not Is_By_Reference_Type (Utyp);
+ end Is_Copy_Type;
+
+ --------------------------------
+ -- Is_Optimizable_Declaration --
+ --------------------------------
+
+ function Is_Optimizable_Declaration (N : Node_Id) return Boolean is
+ begin
+ return Nkind (N) = N_Object_Declaration
+ and then not (Is_Entity_Name (Object_Definition (N))
+ and then Is_Class_Wide_Type
+ (Entity (Object_Definition (N))))
+ and then not Is_Return_Object (Defining_Identifier (N))
+ and then not Is_Copy_Type (Typ);
+ end Is_Optimizable_Declaration;
+
---------------------------
-- OK_For_Single_Subtype --
---------------------------
-- a safe assignment statement, expand into
-- if cond then
- -- lhs := then-expr
+ -- lhs := then-expr;
-- else
-- lhs := else-expr;
-- end if;
-- a simple return statement, expand into
-- if cond then
- -- return then-expr
+ -- return then-expr;
-- else
-- return else-expr;
-- end if;
-- This makes the expansion much easier when expressions are calls to
-- build-in-place functions.
+ Optimize_Object_Decl : Boolean := False;
+ -- Small optimization: when the if expression appears in the context of
+ -- an object declaration of a type not Is_Copy_Type, expand into
+
+ -- if cond then
+ -- then-obj : typ := then_expr;
+ -- target := then-obj'Unrestricted_Access;
+ -- else
+ -- else-obj : typ := else-expr;
+ -- target := else-obj'Unrestricted_Access;
+ -- end if;
+ --
+ -- obj : typ renames target.all;
+
+ -- This makes the expansion much easier when expressions are calls to
+ -- build-in-place functions.
+
-- Start of processing for Expand_N_If_Expression
begin
declare
Uncond_Par : constant Node_Id := Unconditional_Parent (N);
begin
- if Nkind (Uncond_Par) = N_Simple_Return_Statement then
+ if Nkind (Uncond_Par) = N_Simple_Return_Statement
+ or else Is_Optimizable_Declaration (Uncond_Par)
+ then
Delay_Conditional_Expressions_Between (N, Uncond_Par);
end if;
end;
elsif Nkind (Par) = N_Simple_Return_Statement then
Optimize_Return_Stmt := True;
+ elsif Is_Optimizable_Declaration (Par) then
+ Optimize_Object_Decl := True;
+
else
return;
end if;
Condition => Relocate_Node (Cond),
Then_Statements => New_List (New_Then),
Else_Statements => New_List (New_Else));
+ Decl := Empty;
+ New_N := Empty;
-- Preserve the original context for which the if statement is
-- being generated. This is needed by the finalization machinery
Else_Statements => New_List (
Make_Simple_Return_Statement (Sloc (New_Else),
Expression => New_Else)));
+ Decl := Empty;
+ New_N := Empty;
-- Preserve the original context for which the if statement is
-- being generated. This is needed by the finalization machinery
Set_From_Conditional_Expression (If_Stmt);
+ elsif Optimize_Object_Decl then
+ -- When the "then" or "else" expressions involve controlled function
+ -- calls, generated temporaries are chained on the corresponding list
+ -- of actions. These temporaries need to be finalized after the if
+ -- expression is evaluated.
+
+ Process_Transients_In_Expression (N, Then_Actions (N));
+ Process_Transients_In_Expression (N, Else_Actions (N));
+
+ declare
+ Par_Obj : constant Entity_Id := Defining_Identifier (Par);
+ Then_Obj : constant Entity_Id := Make_Temporary (Loc, 'C', Thenx);
+ Else_Obj : constant Entity_Id := Make_Temporary (Loc, 'C', Elsex);
+ Ptr_Typ : constant Entity_Id := Make_Temporary (Loc, 'A');
+ Target : constant Entity_Id := Make_Temporary (Loc, 'C', N);
+
+ begin
+ Insert_Conditional_Object_Declaration (Then_Obj, Thenx, Par);
+ Insert_Conditional_Object_Declaration (Else_Obj, Elsex, Par);
+
+ -- Generate:
+ -- type Ptr_Typ is not null access all [constant] Typ;
+
+ Insert_Action (Par,
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Ptr_Typ,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ All_Present => True,
+ Null_Exclusion_Present => True,
+ Subtype_Indication => New_Occurrence_Of (Typ, Loc),
+ Constant_Present => Constant_Present (Par))));
+
+ -- Generate:
+ -- Target : Ptr_Typ;
+
+ Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Target,
+ Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc));
+ Set_No_Initialization (Decl);
+ Insert_Action (Par, Decl);
+
+ -- Generate:
+ -- if Cond then
+ -- Target := <Then_Obj>'Unrestricted_Access;
+ -- else
+ -- Target := <Else_Obj>'Unrestricted_Access;
+ -- end if;
+
+ If_Stmt :=
+ Make_Implicit_If_Statement (N,
+ Condition => Relocate_Node (Cond),
+ Then_Statements => New_List (
+ Make_Assignment_Statement (Sloc (Thenx),
+ Name => New_Occurrence_Of (Target, Sloc (Thenx)),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Then_Obj, Loc),
+ Attribute_Name => Name_Unrestricted_Access))),
+
+ Else_Statements => New_List (
+ Make_Assignment_Statement (Sloc (Elsex),
+ Name => New_Occurrence_Of (Target, Sloc (Elsex)),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Else_Obj, Loc),
+ Attribute_Name => Name_Unrestricted_Access))));
+
+ -- Preserve the original context for which the if statement is
+ -- being generated. This is needed by the finalization machinery
+ -- to prevent the premature finalization of controlled objects
+ -- found within the if statement.
+
+ Set_From_Conditional_Expression (If_Stmt);
+
+ New_N :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Target, Loc));
+
+ -- The renaming is not analyzed so complete the decoration of the
+ -- object and set the type of the name directly.
+
+ if Constant_Present (Par) then
+ Mutate_Ekind (Par_Obj, E_Constant);
+ Set_Is_True_Constant (Par_Obj);
+ else
+ Mutate_Ekind (Par_Obj, E_Variable);
+ end if;
+
+ Set_Etype (New_N, Etype (Par_Obj));
+ end;
+
-- If the result is a unidimensional unconstrained array but the two
-- dependent expressions have constrained subtypes with known bounds,
-- then we expand as follows:
High_Bound => Build_New_Bound (Then_Hi, Else_Hi, Slice_Hi)));
end;
- -- If the type is by reference or else not definite, then we expand as
- -- follows to avoid the possibility of improper copying.
+ -- If the type cannot be copied, then we expand as follows to avoid the
+ -- possibility of improper copying.
-- type Ptr_Typ is not null access all Typ;
-- Target : Ptr;
-- and replace the if expression by a reference to Target.all.
- elsif Is_By_Reference_Type (Typ)
- or else not Is_Definite_Subtype (Typ)
- then
+ elsif not Is_Copy_Type (Typ) then
-- When the "then" or "else" expressions involve controlled function
-- calls, generated temporaries are chained on the corresponding list
-- of actions. These temporaries need to be finalized after the if
Rewrite (Par, If_Stmt);
Analyze (Par);
+ elsif Optimize_Object_Decl then
+ Insert_Action (Par, If_Stmt);
+ Rewrite_Object_Declaration_As_Renaming (Par, New_N);
+
-- Otherwise rewrite the if expression itself
else
end if;
end Get_Size_For_Range;
+ -------------------------------------------
+ -- Insert_Conditional_Object_Declaration --
+ -------------------------------------------
+
+ procedure Insert_Conditional_Object_Declaration
+ (Obj_Id : Entity_Id;
+ Expr : Node_Id;
+ Decl : Node_Id)
+ is
+ Loc : constant Source_Ptr := Sloc (Expr);
+ Obj_Decl : constant Node_Id :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Obj_Id,
+ Aliased_Present => Aliased_Present (Decl),
+ Constant_Present => Constant_Present (Decl),
+ Object_Definition => New_Copy_Tree (Object_Definition (Decl)),
+ Expression => Relocate_Node (Expr));
+
+ Master_Node_Decl : Node_Id;
+ Master_Node_Id : Entity_Id;
+
+ begin
+ -- If the expression is itself a conditional expression whose
+ -- expansion has been delayed, analyze it again and expand it.
+
+ if Is_Delayed_Conditional_Expression (Expression (Obj_Decl)) then
+ Unanalyze_Delayed_Conditional_Expression (Expression (Obj_Decl));
+ end if;
+
+ Insert_Action (Expr, Obj_Decl);
+
+ -- If the object needs finalization, we need to insert its Master_Node
+ -- manually because 1) the machinery in Exp_Ch7 will not pick it since
+ -- it will be declared in the arm of a conditional statement and 2) we
+ -- cannot invoke Process_Transients_In_Expression on it since it is not
+ -- a transient object (it has the lifetime of the original object).
+
+ if Nkind (Obj_Decl) = N_Object_Declaration
+ and then Needs_Finalization (Base_Type (Etype (Obj_Id)))
+ then
+ Master_Node_Id := Make_Temporary (Loc, 'N');
+ Master_Node_Decl :=
+ Make_Master_Node_Declaration (Loc, Master_Node_Id, Obj_Id);
+
+ -- The master is the innermost enclosing non-transient construct
+
+ Insert_Action (Find_Hook_Context (Expr), Master_Node_Decl);
+
+ -- Propagate the relaxed finalization semantics
+
+ Set_Is_Independent
+ (Master_Node_Id,
+ Has_Relaxed_Finalization (Base_Type (Etype (Obj_Id))));
+
+ -- Generate the attachment of the object to the Master_Node
+
+ Attach_Object_To_Master_Node (Obj_Decl, Master_Node_Id);
+
+ -- Mark the transient object to avoid double finalization
+
+ Set_Is_Finalized_Transient (Obj_Id);
+ end if;
+ end Insert_Conditional_Object_Declaration;
+
-------------------------------
-- Insert_Dereference_Action --
-------------------------------
projects / thirdparty / gcc.git / commitdiff
