diff options
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 52 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 46 |
3 files changed, 72 insertions, 30 deletions
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 7d8a7fd..e60a5f6 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8155,7 +8155,9 @@ package body Exp_Ch3 is Tag_Assign := Make_Tag_Assignment (N); if Present (Tag_Assign) then - if Present (Following_Address_Clause (N)) then + if Present (Following_Address_Clause (N)) + or else Has_Aspect (Def_Id, Aspect_Address) + then Ensure_Freeze_Node (Def_Id); elsif not Special_Ret_Obj then Insert_Action_After (Init_After, Tag_Assign); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index e7bf0bd..aed6bcf 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -27,6 +27,7 @@ -- - controlled types -- - transient scopes +with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; @@ -2799,10 +2800,16 @@ package body Exp_Ch7 is if Ekind (Obj_Id) in E_Constant | E_Variable then + -- The object has delayed freezing. The Master_Node insertion + -- point is after the freeze node. + + if Has_Delayed_Freeze (Obj_Id) then + Master_Node_Ins := Freeze_Node (Obj_Id); + -- The object is initialized by an aggregate. The Master_Node -- insertion point is after the last aggregate assignment. - if Present (Last_Aggregate_Assignment (Obj_Id)) then + elsif Present (Last_Aggregate_Assignment (Obj_Id)) then Master_Node_Ins := Last_Aggregate_Assignment (Obj_Id); -- The object is initialized by a build-in-place function call. @@ -5371,6 +5378,7 @@ package body Exp_Ch7 is First_Obj : Node_Id; Last_Obj : Node_Id; Mark_Id : Entity_Id; + Marker : Node_Id; Target : Node_Id; -- Start of processing for Insert_Actions_In_Scope_Around @@ -5402,9 +5410,6 @@ package body Exp_Ch7 is Target := N; end if; - First_Obj := Target; - Last_Obj := Target; - -- Add all actions associated with a transient scope into the main tree. -- There are several scenarios here: @@ -5415,18 +5420,26 @@ package body Exp_Ch7 is -- 3) Target ........ Last_Obj - -- Flag declarations are inserted before the first object + -- Declarations are inserted before the target if Present (Act_Before) then First_Obj := First (Act_Before); Insert_List_Before (Target, Act_Before); + else + First_Obj := Target; end if; - -- Finalization calls are inserted after the last object + -- Set a marker on the next statement + + Marker := Next (Target); + + -- Finalization calls are inserted after the target if Present (Act_After) then Last_Obj := Last (Act_After); Insert_List_After (Target, Act_After); + else + Last_Obj := Target; end if; -- Mark and release the secondary stack when the context warrants it @@ -5457,6 +5470,33 @@ package body Exp_Ch7 is Related_Node => Target); end if; + -- If the target is the declaration of an object with an address clause + -- or aspect, move all the statements that have been inserted after it + -- into its Initialization_Statements list, so they can be inserted into + -- its freeze actions later. + + if Nkind (Target) = N_Object_Declaration + and then (Present (Following_Address_Clause (Target)) + or else + Has_Aspect (Defining_Identifier (Target), Aspect_Address)) + and then Next (Target) /= Marker + then + declare + Obj_Id : constant Entity_Id := Defining_Identifier (Target); + Stmts : constant List_Id := New_List; + + begin + while Next (Target) /= Marker loop + Append_To (Stmts, Remove_Next (Target)); + end loop; + + pragma Assert (No (Initialization_Statements (Obj_Id))); + + Set_Initialization_Statements + (Obj_Id, Make_Compound_Statement (Loc, Actions => Stmts)); + end; + end if; + -- Reset the action lists Scope_Stack.Table diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 9486d02..b2f1c39 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -635,11 +635,12 @@ package body Freeze is procedure Check_Address_Clause (E : Entity_Id) is Addr : constant Node_Id := Address_Clause (E); Typ : constant Entity_Id := Etype (E); - Decl : Node_Id; - Expr : Node_Id; - Init : Node_Id; - Lhs : Node_Id; - Tag_Assign : Node_Id; + + Assign : Node_Id; + Decl : Node_Id; + Expr : Node_Id; + Init : Node_Id; + Lhs : Node_Id; begin if Present (Addr) then @@ -759,31 +760,30 @@ package body Freeze is Lhs := New_Occurrence_Of (E, Sloc (Decl)); Set_Assignment_OK (Lhs); - -- Move initialization to freeze actions, once the object has - -- been frozen and the address clause alignment check has been - -- performed. - - Append_Freeze_Action (E, + Assign := Make_Assignment_Statement (Sloc (Decl), Name => Lhs, - Expression => Init)); + Expression => Init); Set_No_Initialization (Decl); - -- If the object is tagged, check whether the tag must be - -- reassigned explicitly. - - if Is_Tagged_Type (Typ) and then Tagged_Type_Expansion then - Tag_Assign := - Make_Tag_Assignment_From_Type - (Sloc (Decl), - New_Occurrence_Of (E, Sloc (Decl)), - Underlying_Type (Typ)); + -- If the initialization expression is an aggregate, we do not + -- adjust after the assignment but, in either case, we do not + -- finalize before since the object is now uninitialized. Note + -- that Make_Tag_Ctrl_Assignment will also automatically insert + -- the tag assignment in the tagged case. - if Present (Tag_Assign) then - Append_Freeze_Action (E, Tag_Assign); - end if; + if Nkind (Unqualify (Init)) = N_Aggregate then + Set_No_Ctrl_Actions (Assign); + else + Set_No_Finalize_Actions (Assign); end if; + + -- Move initialization to freeze actions, once the object has + -- been frozen and the address clause alignment check has been + -- performed. + + Append_Freeze_Action (E, Assign); end if; end if; end Check_Address_Clause; |