ada: Fix missing call to Finalize_Protection for simple protected objects

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.

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 585acd8b428560b07c7545b3e86dbf216d9a92f7..5049de54dd70ba91f7427cc7c94e9f54f41cce05 100644 (file)
--- 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 9ac64fe9381e75ee548f73b38574ff723aa783a9..1aff5a062ce0f1afcd31bc2a487d0faddb9d63ce 100644 (file)
--- 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;