Commit a35c1b07 by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Clear confusion about subcomponents of atomic object

2019-12-13  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_util.ads (Is_Atomic_Object): Mention relevant RM clauses.
	* sem_util.adb (Is_Atomic_Object): For an indexed component,
	only look at the Has_Atomic_Components aspect of the prefix and
	do not recurse on it; for a selected component, do not look at
	the prefix.
	(Is_Atomic_Or_VFA_Object): Minor tweak.

From-SVN: r279363
parent 309ff6fb
2019-12-13 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.ads (Is_Atomic_Object): Mention relevant RM clauses.
* sem_util.adb (Is_Atomic_Object): For an indexed component,
only look at the Has_Atomic_Components aspect of the prefix and
do not recurse on it; for a selected component, do not look at
the prefix.
(Is_Atomic_Or_VFA_Object): Minor tweak.
2019-12-13 Arnaud Charlet <charlet@adacore.com> 2019-12-13 Arnaud Charlet <charlet@adacore.com>
* libgnat/a-calfor.ads, libgnat/a-calfor.adb (Split_Duration): * libgnat/a-calfor.ads, libgnat/a-calfor.adb (Split_Duration):
......
...@@ -13724,54 +13724,33 @@ package body Sem_Util is ...@@ -13724,54 +13724,33 @@ package body Sem_Util is
---------------------- ----------------------
function Is_Atomic_Object (N : Node_Id) return Boolean is function Is_Atomic_Object (N : Node_Id) return Boolean is
function Is_Atomic_Entity (Id : Entity_Id) return Boolean; function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean;
pragma Inline (Is_Atomic_Entity); -- Determine whether prefix Pref of an indexed component has atomic
-- Determine whether arbitrary entity Id is either atomic or has atomic
-- components. -- components.
function Is_Atomic_Prefix (Pref : Node_Id) return Boolean; ---------------------------------
-- Determine whether prefix Pref of an indexed or selected component is -- Prefix_Has_Atomic_Components --
-- an atomic object. ---------------------------------
----------------------
-- Is_Atomic_Entity --
----------------------
function Is_Atomic_Entity (Id : Entity_Id) return Boolean is
begin
return Is_Atomic (Id) or else Has_Atomic_Components (Id);
end Is_Atomic_Entity;
----------------------
-- Is_Atomic_Prefix --
----------------------
function Is_Atomic_Prefix (Pref : Node_Id) return Boolean is function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean is
Typ : constant Entity_Id := Etype (Pref); Typ : constant Entity_Id := Etype (Pref);
begin begin
if Is_Access_Type (Typ) then if Is_Access_Type (Typ) then
return Has_Atomic_Components (Designated_Type (Typ)); return Has_Atomic_Components (Designated_Type (Typ));
elsif Is_Atomic_Entity (Typ) then elsif Has_Atomic_Components (Typ) then
return True; return True;
elsif Is_Entity_Name (Pref) elsif Is_Entity_Name (Pref)
and then Is_Atomic_Entity (Entity (Pref)) and then Has_Atomic_Components (Entity (Pref))
then then
return True; return True;
elsif Nkind (Pref) = N_Indexed_Component then else
return Is_Atomic_Prefix (Prefix (Pref)); return False;
elsif Nkind (Pref) = N_Selected_Component then
return
Is_Atomic_Prefix (Prefix (Pref))
or else Is_Atomic (Entity (Selector_Name (Pref)));
end if; end if;
end Prefix_Has_Atomic_Components;
return False;
end Is_Atomic_Prefix;
-- Start of processing for Is_Atomic_Object -- Start of processing for Is_Atomic_Object
...@@ -13780,12 +13759,13 @@ package body Sem_Util is ...@@ -13780,12 +13759,13 @@ package body Sem_Util is
return Is_Atomic_Object_Entity (Entity (N)); return Is_Atomic_Object_Entity (Entity (N));
elsif Nkind (N) = N_Indexed_Component then elsif Nkind (N) = N_Indexed_Component then
return Is_Atomic (Etype (N)) or else Is_Atomic_Prefix (Prefix (N)); return
Is_Atomic (Etype (N))
or else Prefix_Has_Atomic_Components (Prefix (N));
elsif Nkind (N) = N_Selected_Component then elsif Nkind (N) = N_Selected_Component then
return return
Is_Atomic (Etype (N)) Is_Atomic (Etype (N))
or else Is_Atomic_Prefix (Prefix (N))
or else Is_Atomic (Entity (Selector_Name (N))); or else Is_Atomic (Entity (Selector_Name (N)));
end if; end if;
...@@ -13810,8 +13790,8 @@ package body Sem_Util is ...@@ -13810,8 +13790,8 @@ package body Sem_Util is
function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is
begin begin
return Is_Atomic_Object (N) return Is_Atomic_Object (N)
or else (Is_Object_Reference (N) or else (Is_Entity_Name (N)
and then Is_Entity_Name (N) and then Is_Object (Entity (N))
and then (Is_Volatile_Full_Access (Entity (N)) and then (Is_Volatile_Full_Access (Entity (N))
or else or else
Is_Volatile_Full_Access (Etype (Entity (N))))); Is_Volatile_Full_Access (Etype (Entity (N)))));
......
...@@ -1531,7 +1531,7 @@ package Sem_Util is ...@@ -1531,7 +1531,7 @@ package Sem_Util is
function Is_Atomic_Object (N : Node_Id) return Boolean; function Is_Atomic_Object (N : Node_Id) return Boolean;
-- Determine whether arbitrary node N denotes a reference to an atomic -- Determine whether arbitrary node N denotes a reference to an atomic
-- object as per Ada RM C.6(12). -- object as per Ada RM C.6(7) and the crucial remark in C.6(8).
-- WARNING: There is a matching C declaration of this subprogram in fe.h -- WARNING: There is a matching C declaration of this subprogram in fe.h
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment