[gcc r13-7912] ada: Fix missing call to Finalize_Protection for simple protected objects

[Eric Botcazou <ebotcazou@gcc.gnu.org>]

https://gcc.gnu.org/g:81185fb76aa691a6d23db70070b79b0cba4bcbe2

commit r13-7912-g81185fb76aa691a6d23db70070b79b0cba4bcbe2
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Mon Sep 18 09:14:46 2023 +0200

    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:
---
 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 757cf7318f9..e9a4b394999 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2351,8 +2351,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;
@@ -3085,7 +3084,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));
@@ -3097,6 +3098,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);
@@ -3259,12 +3261,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 fe48722cedd..fb81063eee7 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -12869,10 +12869,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;