aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2024-01-25 19:09:01 +0100
committerMarc Poulhiès <poulhies@adacore.com>2024-05-13 10:03:31 +0200
commit65c0029fd969b30794ee0778ddb08e60ee45d770 (patch)
tree218cfa2f47ff96d6130b75aab34db1f76382235d /gcc
parent0533acf60438aec7858b18b0b52706ca6f1b3564 (diff)
downloadgcc-65c0029fd969b30794ee0778ddb08e60ee45d770.zip
gcc-65c0029fd969b30794ee0778ddb08e60ee45d770.tar.gz
gcc-65c0029fd969b30794ee0778ddb08e60ee45d770.tar.bz2
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_ch9.adb19
1 files changed, 16 insertions, 3 deletions
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 17d997b..1b231b8 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