https://gcc.gnu.org/g:65c0029fd969b30794ee0778ddb08e60ee45d770

commit r15-409-g65c0029fd969b30794ee0778ddb08e60ee45d770
Author: Piotr Trojanek <troja...@adacore.com>
Date:   Thu Jan 25 19:09:01 2024 +0100

    ada: Complete implementation of Ada 2022 aspect Exclusive_Functions
    
    Extend implementation of RM 9.5.1(7/4), which now applies also to
    protected function if the protected type has aspect Exclusive_Functions.
    
    gcc/ada/
    
            * exp_ch9.adb (Build_Protected_Subprogram_Call_Cleanup): If
            aspect Exclusive_Functions is present then the cleanup of a
            protected function now services queued entries, just like the
            cleanup of a protected procedure.

Diff:
---
 gcc/ada/exp_ch9.adb | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 17d997b9f603..1b231b8bf2c2 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4032,12 +4032,25 @@ package body Exp_Ch9 is
       Nam : Node_Id;
 
    begin
-      --  If the associated protected object has entries, a protected
-      --  procedure has to service entry queues. In this case generate:
+      --  If the associated protected object has entries, the expanded
+      --  exclusive protected operation has to service entry queues. In
+      --  this case generate:
 
       --    Service_Entries (_object._object'Access);
 
-      if Nkind (Op_Spec) = N_Procedure_Specification
+      if (Nkind (Op_Spec) = N_Procedure_Specification
+            or else
+          (Nkind (Op_Spec) = N_Function_Specification
+             and then Has_Aspect (Conc_Typ, Aspect_Exclusive_Functions)
+             and then
+               (No
+                 (Find_Value_Of_Aspect (Conc_Typ,
+                    Aspect_Exclusive_Functions))
+                  or else
+                Is_True
+                  (Static_Boolean
+                     (Find_Value_Of_Aspect
+                        (Conc_Typ, Aspect_Exclusive_Functions))))))
         and then Has_Entries (Conc_Typ)
       then
          case Corresponding_Runtime_Package (Conc_Typ) is

Reply via email to