* [Ada] Missing finalization on generic instantiation
@ 2021-05-04 9:52 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-05-04 9:52 UTC (permalink / raw)
To: gcc-patches; +Cc: Arnaud Charlet
[-- Attachment #1: Type: text/plain, Size: 795 bytes --]
If some objects are declared in the body of a generic package, these
objects are not finalized when the package is instantiated at the
library level.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* exp_ch7.adb (Build_Finalizer_Helper.New_Finalizer_Name):
Unnest so that it can be reused.
(Build_Finalizer_Helper.Process_Declarations): Call the
xxx__finalize_body procedure of a package instantiation in case
it contains finalization statements. Code clean ups.
(Build_Finalizer_Helper.Create_Finalizer): Export and set an
Interface_Name for library level finalizers since these may be
imported now.
(Build_Finalizer_Helper): Need to process library level package
body instantiations which may contain objects requiring
finalization.
* libgnat/s-finmas.ads: Fix typo.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 12074 bytes --]
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -1547,6 +1547,11 @@ package body Exp_Ch7 is
-- Create the spec and body of the finalizer and insert them in the
-- proper place in the tree depending on the context.
+ function New_Finalizer_Name
+ (Spec_Id : Node_Id; For_Spec : Boolean) return Name_Id;
+ -- Create a fully qualified name of a package spec or body finalizer.
+ -- The generated name is of the form: xx__yy__finalize_[spec|body].
+
procedure Process_Declarations
(Decls : List_Id;
Preprocess : Boolean := False;
@@ -1554,7 +1559,8 @@ package body Exp_Ch7 is
-- Inspect a list of declarations or statements which may contain
-- objects that need finalization. When flag Preprocess is set, the
-- routine will simply count the total number of controlled objects in
- -- Decls. Flag Top_Level denotes whether the processing is done for
+ -- Decls and set Counter_Val accordingly. Top_Level is only relevant
+ -- when Preprocess is set and if True, the processing is performed for
-- objects in nested package declarations or instances.
procedure Process_Object_Declaration
@@ -1689,58 +1695,6 @@ package body Exp_Ch7 is
----------------------
procedure Create_Finalizer is
- function New_Finalizer_Name return Name_Id;
- -- Create a fully qualified name of a package spec or body finalizer.
- -- The generated name is of the form: xx__yy__finalize_[spec|body].
-
- ------------------------
- -- New_Finalizer_Name --
- ------------------------
-
- function New_Finalizer_Name return Name_Id is
- procedure New_Finalizer_Name (Id : Entity_Id);
- -- Place "__<name-of-Id>" in the name buffer. If the identifier
- -- has a non-standard scope, process the scope first.
-
- ------------------------
- -- New_Finalizer_Name --
- ------------------------
-
- procedure New_Finalizer_Name (Id : Entity_Id) is
- begin
- if Scope (Id) = Standard_Standard then
- Get_Name_String (Chars (Id));
-
- else
- New_Finalizer_Name (Scope (Id));
- Add_Str_To_Name_Buffer ("__");
- Add_Str_To_Name_Buffer (Get_Name_String (Chars (Id)));
- end if;
- end New_Finalizer_Name;
-
- -- Start of processing for New_Finalizer_Name
-
- begin
- -- Create the fully qualified name of the enclosing scope
-
- New_Finalizer_Name (Spec_Id);
-
- -- Generate:
- -- __finalize_[spec|body]
-
- Add_Str_To_Name_Buffer ("__finalize_");
-
- if For_Package_Spec then
- Add_Str_To_Name_Buffer ("spec");
- else
- Add_Str_To_Name_Buffer ("body");
- end if;
-
- return Name_Find;
- end New_Finalizer_Name;
-
- -- Local variables
-
Body_Id : Entity_Id;
Fin_Body : Node_Id;
Fin_Spec : Node_Id;
@@ -1748,8 +1702,6 @@ package body Exp_Ch7 is
Label : Node_Id;
Label_Id : Entity_Id;
- -- Start of processing for Create_Finalizer
-
begin
-- Step 1: Creation of the finalizer name
@@ -1760,7 +1712,8 @@ package body Exp_Ch7 is
-- xx__yy__finalize_[spec|body]
if For_Package then
- Fin_Id := Make_Defining_Identifier (Loc, New_Finalizer_Name);
+ Fin_Id := Make_Defining_Identifier
+ (Loc, New_Finalizer_Name (Spec_Id, For_Package_Spec));
Set_Has_Qualified_Name (Fin_Id);
Set_Has_Fully_Qualified_Name (Fin_Id);
@@ -1836,10 +1789,22 @@ package body Exp_Ch7 is
Make_Procedure_Specification (Loc,
Defining_Unit_Name => Fin_Id));
+ if For_Package then
+ Set_Is_Exported (Fin_Id);
+ Set_Interface_Name (Fin_Id,
+ Make_String_Literal (Loc,
+ Strval => Get_Name_String (Chars (Fin_Id))));
+ end if;
+
-- Step 3: Creation of the finalizer body
- if Has_Ctrl_Objs then
+ -- Has_Ctrl_Objs might be set because of a generic package body having
+ -- controlled objects. In this case, Jump_Alts may be empty and no
+ -- case nor goto statements are needed.
+ if Has_Ctrl_Objs
+ and then not Is_Empty_List (Jump_Alts)
+ then
-- Add L0, the default destination to the jump block
Label_Id := Make_Identifier (Loc, New_External_Name ('L', 0));
@@ -2161,6 +2126,54 @@ package body Exp_Ch7 is
Set_Is_Checked_Ghost_Entity (Fin_Id, False);
end Create_Finalizer;
+ ------------------------
+ -- New_Finalizer_Name --
+ ------------------------
+
+ function New_Finalizer_Name
+ (Spec_Id : Node_Id; For_Spec : Boolean) return Name_Id
+ is
+ procedure New_Finalizer_Name (Id : Entity_Id);
+ -- Place "__<name-of-Id>" in the name buffer. If the identifier
+ -- has a non-standard scope, process the scope first.
+
+ ------------------------
+ -- New_Finalizer_Name --
+ ------------------------
+
+ procedure New_Finalizer_Name (Id : Entity_Id) is
+ begin
+ if Scope (Id) = Standard_Standard then
+ Get_Name_String (Chars (Id));
+
+ else
+ New_Finalizer_Name (Scope (Id));
+ Add_Str_To_Name_Buffer ("__");
+ Get_Name_String_And_Append (Chars (Id));
+ end if;
+ end New_Finalizer_Name;
+
+ -- Start of processing for New_Finalizer_Name
+
+ begin
+ -- Create the fully qualified name of the enclosing scope
+
+ New_Finalizer_Name (Spec_Id);
+
+ -- Generate:
+ -- __finalize_[spec|body]
+
+ Add_Str_To_Name_Buffer ("__finalize_");
+
+ if For_Spec then
+ Add_Str_To_Name_Buffer ("spec");
+ else
+ Add_Str_To_Name_Buffer ("body");
+ end if;
+
+ return Name_Find;
+ end New_Finalizer_Name;
+
--------------------------
-- Process_Declarations --
--------------------------
@@ -2540,6 +2553,73 @@ package body Exp_Ch7 is
end if;
end if;
+ -- Call the xxx__finalize_body procedure of a library level
+ -- package instantiation if the body contains finalization
+ -- statements.
+
+ if Present (Generic_Parent (Spec))
+ and then Is_Library_Level_Entity (Pack_Id)
+ and then Present (Body_Entity (Generic_Parent (Spec)))
+ then
+ if Preprocess then
+ declare
+ P : Node_Id;
+ begin
+ P := Parent (Body_Entity (Generic_Parent (Spec)));
+ while Present (P)
+ and then Nkind (P) /= N_Package_Body
+ loop
+ P := Parent (P);
+ end loop;
+
+ if Present (P) then
+ Old_Counter_Val := Counter_Val;
+ Process_Declarations (Declarations (P), Preprocess);
+
+ -- Note that we are processing the generic body
+ -- template and not the actually instantiation
+ -- (which is generated too late for us to process
+ -- it), so there is no need to update in particular
+ -- to update Last_Top_Level_Ctrl_Construct here.
+
+ if Counter_Val > Old_Counter_Val then
+ Counter_Val := Old_Counter_Val;
+ Set_Has_Controlled_Component (Pack_Id);
+ end if;
+ end if;
+ end;
+
+ elsif Has_Controlled_Component (Pack_Id) then
+
+ -- We import the xxx__finalize_body routine since the
+ -- generic body will be instantiated later.
+
+ declare
+ Id : constant Node_Id :=
+ Make_Defining_Identifier (Loc,
+ New_Finalizer_Name (Defining_Unit_Name (Spec),
+ For_Spec => False));
+
+ begin
+ Set_Has_Qualified_Name (Id);
+ Set_Has_Fully_Qualified_Name (Id);
+ Set_Is_Imported (Id);
+ Set_Has_Completion (Id);
+ Set_Interface_Name (Id,
+ Make_String_Literal (Loc,
+ Strval => Get_Name_String (Chars (Id))));
+
+ Append_New_To (Finalizer_Stmts,
+ Make_Subprogram_Declaration (Loc,
+ Make_Procedure_Specification (Loc,
+ Defining_Unit_Name => Id)));
+ Append_To (Finalizer_Stmts,
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (Id, Loc)));
+ end;
+ end if;
+ end if;
+
-- Nested package bodies, avoid generics
elsif Nkind (Decl) = N_Package_Body then
@@ -2550,8 +2630,7 @@ package body Exp_Ch7 is
if Is_Ignored_Ghost_Entity (Defining_Entity (Decl)) then
null;
- elsif Ekind (Corresponding_Spec (Decl)) /=
- E_Generic_Package
+ elsif Ekind (Corresponding_Spec (Decl)) /= E_Generic_Package
then
Old_Counter_Val := Counter_Val;
Process_Declarations (Declarations (Decl), Preprocess);
@@ -3041,6 +3120,8 @@ package body Exp_Ch7 is
-- Otherwise the initialization calls follow the related object
else
+ pragma Assert (Present (Stmt));
+
Stmt_2 := Next_Suitable_Statement (Stmt);
-- Check for an optional call to Deep_Initialize which may
@@ -3542,6 +3623,14 @@ package body Exp_Ch7 is
or else Scope_Depth_Value (Spec_Id) /= Uint_1
or else (Is_Generic_Instance (Spec_Id)
and then Package_Instantiation (Spec_Id) /= N))
+
+ -- Still need to process package body instantiations which may
+ -- contain objects requiring finalization.
+
+ and then not
+ (For_Package_Body
+ and then Is_Library_Level_Entity (Spec_Id)
+ and then Is_Generic_Instance (Spec_Id))
then
return;
end if;
@@ -3623,7 +3712,7 @@ package body Exp_Ch7 is
-- Step 3: Finalizer creation
- if Acts_As_Clean or else Has_Ctrl_Objs or else Has_Tagged_Types then
+ if Acts_As_Clean or Has_Ctrl_Objs or Has_Tagged_Types then
Create_Finalizer;
end if;
end Build_Finalizer_Helper;
diff --git a/gcc/ada/libgnat/s-finmas.ads b/gcc/ada/libgnat/s-finmas.ads
--- a/gcc/ada/libgnat/s-finmas.ads
+++ b/gcc/ada/libgnat/s-finmas.ads
@@ -74,7 +74,7 @@ package System.Finalization_Masters is
for Finalization_Master_Ptr'Storage_Size use 0;
procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
- -- Compiler interface, do not call from withing the run-time. Prepend a
+ -- Compiler interface, do not call from within the run-time. Prepend a
-- node to a specific finalization master.
procedure Attach_Unprotected
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-05-04 9:52 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-04 9:52 [Ada] Missing finalization on generic instantiation Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).