From: Eric Botcazou <ebotca...@adacore.com>
The clause and aspect have been accepted by the compiler for a few years,
but the result is generally an internal compiler error or an incorrect
finalization at run time.
gcc/ada/ChangeLog:
* exp_ch3.adb (Expand_N_Object_Declaration): Do not insert the tag
assignment there if the object has the Address aspect.
* exp_ch7.adb: Add clauses for Aspect package.
(Build_Finalizer.Process_Object_Declaration): Deal with an object
with delayed freezing.
(Insert_Actions_In_Scope_Around): If the target is the declaration
of an object with address clause or aspect, move all the statements
that have been inserted after it into the Initialization_Statements
list of the object.
* freeze.adb (Check_Address_Clause): Do not reassign the tag here,
instead set the appropriate flag on the assignment statement.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 4 +++-
gcc/ada/exp_ch7.adb | 52 +++++++++++++++++++++++++++++++++++++++------
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 7d8a7fd4fed..e60a5f6ddaf 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 e7bf0bd7f11..aed6bcf356f 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 9486d02f681..b2f1c3913a7 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;
--
2.43.0
