From: Eric Botcazou <ebotca...@adacore.com>
There is a glitch in Exp_Ch7.Build_Finalizer causing the finalizer to do
nothing for simple protected objects.
The change also removes redundant calls to the Is_Simple_Protected_Type
predicate and fixes a minor inconsistency between Requires_Cleanup_Actions
and Build_Finalizer for this case.
gcc/ada/
* exp_ch7.adb (Build_Finalizer.Process_Declarations): Remove call
to Is_Simple_Protected_Type as redundant.
(Build_Finalizer.Process_Object_Declaration): Do not retrieve the
corresponding record type for simple protected objects. Make the
flow of control more explicit in their specific processing.
* exp_util.adb (Requires_Cleanup_Actions): Return false for simple
protected objects present in library-level package bodies for the
sake of consistency with Build_Finalizer and remove call to
Is_Simple_Protected_Type as redundant.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch7.adb | 19 ++++++++++---------
gcc/ada/exp_util.adb | 32 ++++++++++++++++++++++++++++++--
2 files changed, 40 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 585acd8b428..5049de54dd7 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2356,8 +2356,7 @@ package body Exp_Ch7 is
elsif Ekind (Obj_Id) = E_Variable
and then not In_Library_Level_Package_Body (Obj_Id)
- and then (Is_Simple_Protected_Type (Obj_Typ)
- or else Has_Simple_Protected_Object (Obj_Typ))
+ and then Has_Simple_Protected_Object (Obj_Typ)
then
Processing_Actions (Is_Protected => True);
end if;
@@ -3006,7 +3005,9 @@ package body Exp_Ch7 is
-- Start of processing for Process_Object_Declaration
begin
- -- Handle the object type and the reference to the object
+ -- Handle the object type and the reference to the object. Note
+ -- that objects having simple protected components must retain
+ -- their original form for the processing below to work.
Obj_Ref := New_Occurrence_Of (Obj_Id, Loc);
Obj_Typ := Base_Type (Etype (Obj_Id));
@@ -3018,6 +3019,7 @@ package body Exp_Ch7 is
elsif Is_Concurrent_Type (Obj_Typ)
and then Present (Corresponding_Record_Type (Obj_Typ))
+ and then not Is_Protected
then
Obj_Typ := Corresponding_Record_Type (Obj_Typ);
Obj_Ref := Unchecked_Convert_To (Obj_Typ, Obj_Ref);
@@ -3180,12 +3182,11 @@ package body Exp_Ch7 is
Fin_Stmts := New_List (Fin_Call);
end if;
- elsif Has_Simple_Protected_Object (Obj_Typ) then
- if Is_Record_Type (Obj_Typ) then
- Fin_Stmts := Cleanup_Record (Decl, Obj_Ref, Obj_Typ);
- elsif Is_Array_Type (Obj_Typ) then
- Fin_Stmts := Cleanup_Array (Decl, Obj_Ref, Obj_Typ);
- end if;
+ elsif Is_Array_Type (Obj_Typ) then
+ Fin_Stmts := Cleanup_Array (Decl, Obj_Ref, Obj_Typ);
+
+ else
+ Fin_Stmts := Cleanup_Record (Decl, Obj_Ref, Obj_Typ);
end if;
-- Generate:
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 9ac64fe9381..1aff5a062ce 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13100,10 +13100,38 @@ package body Exp_Util is
-- Simple protected objects which use type System.Tasking.
-- Protected_Objects.Protection to manage their locks should be
-- treated as controlled since they require manual cleanup.
+ -- The only exception is illustrated in the following example:
+
+ -- package Pkg is
+ -- type Ctrl is new Controlled ...
+ -- procedure Finalize (Obj : in out Ctrl);
+ -- Lib_Obj : Ctrl;
+ -- end Pkg;
+
+ -- package body Pkg is
+ -- protected Prot is
+ -- procedure Do_Something (Obj : in out Ctrl);
+ -- end Prot;
+
+ -- protected body Prot is
+ -- procedure Do_Something (Obj : in out Ctrl) is ...
+ -- end Prot;
+
+ -- procedure Finalize (Obj : in out Ctrl) is
+ -- begin
+ -- Prot.Do_Something (Obj);
+ -- end Finalize;
+ -- end Pkg;
+
+ -- Since for the most part entities in package bodies depend on
+ -- those in package specs, Prot's lock should be cleaned up
+ -- first. The subsequent cleanup of the spec finalizes Lib_Obj.
+ -- This act however attempts to invoke Do_Something and fails
+ -- because the lock has disappeared.
elsif Ekind (Obj_Id) = E_Variable
- and then (Is_Simple_Protected_Type (Obj_Typ)
- or else Has_Simple_Protected_Object (Obj_Typ))
+ and then not In_Library_Level_Package_Body (Obj_Id)
+ and then Has_Simple_Protected_Object (Obj_Typ)
then
return True;
end if;
--
2.42.0
