Implement changes in SPARK RM 9(1): previously an object was
'synchronized' if it was a constant, now constants are only synchronized
if they are not of an access-to-variable type.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.ads, sem_util.adb (Is_Access_Variable): New function.
(Is_Synchronized_Object): Call new function when determining if
a constant can be regarded as synchronized.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14337,6 +14337,16 @@ package body Sem_Util is
return Nkind (Par) in N_Subprogram_Call;
end Is_Anonymous_Access_Actual;
+ ------------------------
+ -- Is_Access_Variable --
+ ------------------------
+
+ function Is_Access_Variable (E : Entity_Id) return Boolean is
+ begin
+ return Is_Access_Object_Type (E)
+ and then not Is_Access_Constant (E);
+ end Is_Access_Variable;
+
-----------------------------
-- Is_Actual_Out_Parameter --
-----------------------------
@@ -19149,9 +19159,12 @@ package body Sem_Util is
then
return True;
- -- A constant is a synchronized object by default
+ -- A constant is a synchronized object by default, unless its type is
+ -- access-to-variable type.
- elsif Ekind (Id) = E_Constant then
+ elsif Ekind (Id) = E_Constant
+ and then not Is_Access_Variable (Etype (Id))
+ then
return True;
-- A variable is a synchronized object if it is subject to pragma
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1596,6 +1596,9 @@ package Sem_Util is
-- True if E is the constructed wrapper for an access_to_subprogram
-- type with Pre/Postconditions.
+ function Is_Access_Variable (E : Entity_Id) return Boolean;
+ -- Determines if type E is an access-to-variable
+
function Is_Actual_In_Out_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter of in-out mode in a subprogram
-- call.
@@ -2166,7 +2169,7 @@ package Sem_Util is
-- such, the object must be
-- * Of a type that yields a synchronized object
-- * An atomic object with enabled Async_Writers
- -- * A constant
+ -- * A constant not of access-to-variable type
-- * A variable subject to pragma Constant_After_Elaboration
function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean;