diff mbox series

[Ada] Clear confusion about subcomponents of atomic object

Message ID 20191213095501.GA14055@adacore.com
State New
Headers show
Series [Ada] Clear confusion about subcomponents of atomic object | expand

Commit Message

Pierre-Marie de Rodat Dec. 13, 2019, 9:55 a.m. UTC 
The Ada RM explicitly says in the C.6 sub-chapter that, contrary to what
happens for the Volatile aspect, the Atomic aspect doesn't automatically
propagate down to subcomponents of atomic objects.

That is not what is implemented in the compiler, in particular in the
Is_Atomic_Object predicate of Sem_Util, so the change fixes this gap.

It also contains a minor tweak to the Is_Atomic_Or_VFA_Object predicate.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
diff mbox series

Patch

--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -13724,54 +13724,33 @@  package body Sem_Util is
    ----------------------
 
    function Is_Atomic_Object (N : Node_Id) return Boolean is
-      function Is_Atomic_Entity (Id : Entity_Id) return Boolean;
-      pragma Inline (Is_Atomic_Entity);
-      --  Determine whether arbitrary entity Id is either atomic or has atomic
+      function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean;
+      --  Determine whether prefix Pref of an indexed component has atomic
       --  components.
 
-      function Is_Atomic_Prefix (Pref : Node_Id) return Boolean;
-      --  Determine whether prefix Pref of an indexed or selected component is
-      --  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 --
-      ----------------------
+      ---------------------------------
+      -- Prefix_Has_Atomic_Components --
+      ---------------------------------
 
-      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);
 
       begin
          if Is_Access_Type (Typ) then
             return Has_Atomic_Components (Designated_Type (Typ));
 
-         elsif Is_Atomic_Entity (Typ) then
+         elsif Has_Atomic_Components (Typ) then
             return True;
 
          elsif Is_Entity_Name (Pref)
-           and then Is_Atomic_Entity (Entity (Pref))
+           and then Has_Atomic_Components (Entity (Pref))
          then
             return True;
 
-         elsif Nkind (Pref) = N_Indexed_Component then
-            return Is_Atomic_Prefix (Prefix (Pref));
-
-         elsif Nkind (Pref) = N_Selected_Component then
-            return
-              Is_Atomic_Prefix (Prefix (Pref))
-                or else Is_Atomic (Entity (Selector_Name (Pref)));
+         else
+            return False;
          end if;
-
-         return False;
-      end Is_Atomic_Prefix;
+      end Prefix_Has_Atomic_Components;
 
    --  Start of processing for Is_Atomic_Object
 
@@ -13780,12 +13759,13 @@  package body Sem_Util is
          return Is_Atomic_Object_Entity (Entity (N));
 
       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
          return
            Is_Atomic (Etype (N))
-             or else Is_Atomic_Prefix (Prefix (N))
              or else Is_Atomic (Entity (Selector_Name (N)));
       end if;
 
@@ -13810,8 +13790,8 @@  package body Sem_Util is
    function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is
    begin
       return Is_Atomic_Object (N)
-        or else (Is_Object_Reference (N)
-                   and then Is_Entity_Name (N)
+        or else (Is_Entity_Name (N)
+                   and then Is_Object (Entity (N))
                    and then (Is_Volatile_Full_Access (Entity (N))
                                 or else
                              Is_Volatile_Full_Access (Etype (Entity (N)))));

--- gcc/ada/sem_util.ads
+++ gcc/ada/sem_util.ads
@@ -1531,7 +1531,7 @@  package Sem_Util is
 
    function Is_Atomic_Object (N : Node_Id) return Boolean;
    --  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