[Ada] Constants no longer synchronised if they are access-to-variable

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.
This commit is contained in:
Chris Martin 2020-06-16 10:16:06 +01:00 committed by Pierre-Marie de Rodat
parent 7e8e3cb479
commit d931c94ea2
2 changed files with 19 additions and 3 deletions

View File

@ -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

View File

@ -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;