[Ada] Fully propagate representation aspects through renaming

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

gcc/ada/

	* sem_ch8.adb (Analyze_Object_Renaming): Set Atomic, Independent
	and Volatile_Full_Access aspects on the entity of the renaming
	the same way as the Volatile aspect is set.
	* sem_util.ads (Is_Atomic_Object_Entity): Move declaration to...
	(Is_Independent_Object): New function.
	(Is_Volatile_Full_Access_Object): Likewise.
	* sem_util.adb (Is_Atomic_Object_Entity): ...here.
	(Prefix_Has_Atomic_Components): Minor tweak.
	(Is_Atomic_Object): Test Is_Atomic on the Etype uniformly.
	(Is_Atomic_Or_VFA_Object): Call Is_Volatile_Full_Access_Object.
	(Is_Independent_Object): New predicate.
	(Is_Subcomponent_Of_Atomic_Object): Remove redundant test.
	(Is_Volatile_Full_Access_Object): New predicate.
	(Is_Volatile_Prefix): Rename into...
	(Prefix_Has_Volatile_Components): ... and call
	Is_Volatile_Object.
	(Object_Has_Volatile_Components): Delete.
	(Is_Volatile_Object): Simplify.
	* gcc-interface/trans.c (node_is_volatile_full_access): Adjust
	comment.

From-SVN: r279429

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a4ab24a5d6f3616b6c67ec0718f63f99b276443d..a3832b8234dab70db0a5b782eb41727f59bcab59 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2019-12-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * sem_ch8.adb (Analyze_Object_Renaming): Set Atomic, Independent
+       and Volatile_Full_Access aspects on the entity of the renaming
+       the same way as the Volatile aspect is set.
+       * sem_util.ads (Is_Atomic_Object_Entity): Move declaration to...
+       (Is_Independent_Object): New function.
+       (Is_Volatile_Full_Access_Object): Likewise.
+       * sem_util.adb (Is_Atomic_Object_Entity): ...here.
+       (Prefix_Has_Atomic_Components): Minor tweak.
+       (Is_Atomic_Object): Test Is_Atomic on the Etype uniformly.
+       (Is_Atomic_Or_VFA_Object): Call Is_Volatile_Full_Access_Object.
+       (Is_Independent_Object): New predicate.
+       (Is_Subcomponent_Of_Atomic_Object): Remove redundant test.
+       (Is_Volatile_Full_Access_Object): New predicate.
+       (Is_Volatile_Prefix): Rename into...
+       (Prefix_Has_Volatile_Components): ... and call
+       Is_Volatile_Object.
+       (Object_Has_Volatile_Components): Delete.
+       (Is_Volatile_Object): Simplify.
+       * gcc-interface/trans.c (node_is_volatile_full_access): Adjust
+       comment.
+
 2019-12-16  Bob Duff  <duff@adacore.com>
 
        * par.adb: Add Scopes function to do range checking on the scope

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 762ca465c9484c1f36a55bc4f944de64d14418f3..e6914cc470c03513fdd4a45c6760d70bea3ba0c0 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -4835,8 +4835,8 @@ node_is_atomic (Node_Id gnat_node)
 }
 
 /* Return true if GNAT_NODE references a Volatile_Full_Access entity.  This is
-   modeled on the Is_VFA_Object predicate of the front-end, but additionally
-   handles explicit dereferences.  */
+   modeled on the Is_Volatile_Full_Access_Object predicate of the front-end,
+   but additionally handles explicit dereferences.  */
 
 static bool
 node_is_volatile_full_access (Node_Id gnat_node)

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 8897b25e04657862b401d23c5962b9fd1523cf32..a1a5274d078c19e2043203622f2c1ebc986a22c4 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1358,19 +1358,13 @@ package body Sem_Ch8 is
       end if;
 
       --  The entity of the renaming declaration needs to reflect whether the
-      --  renamed object is volatile. Is_Volatile is set if the renamed object
-      --  is volatile in the RM legality sense.
+      --  renamed object is atomic, independent, volatile or VFA. These flags
+      --  are set on the renamed object in the RM legality sense.
 
-      Set_Is_Volatile (Id, Is_Volatile_Object (Nam));
-
-      --  Also copy settings of Atomic/Independent/Volatile_Full_Access
-
-      if Is_Entity_Name (Nam) then
-         Set_Is_Atomic               (Id, Is_Atomic      (Entity (Nam)));
-         Set_Is_Independent          (Id, Is_Independent (Entity (Nam)));
-         Set_Is_Volatile_Full_Access (Id,
-           Is_Volatile_Full_Access (Entity (Nam)));
-      end if;
+      Set_Is_Atomic               (Id, Is_Atomic_Object (Nam));
+      Set_Is_Independent          (Id, Is_Independent_Object (Nam));
+      Set_Is_Volatile             (Id, Is_Volatile_Object (Nam));
+      Set_Is_Volatile_Full_Access (Id, Is_Volatile_Full_Access_Object (Nam));
 
       --  Treat as volatile if we just set the Volatile flag
 

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 72126372f30bef5cbae23dd91d375848327ec143..e1703e995f11d8bc31cd1fa02a1a484904e90118 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -122,6 +122,10 @@ package body Sem_Util is
    --  T is a derived tagged type. Check whether the type extension is null.
    --  If the parent type is fully initialized, T can be treated as such.
 
+   function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean;
+   --  Determine whether arbitrary entity Id denotes an atomic object as per
+   --  RM C.6(7).
+
    function Is_Fully_Initialized_Variant (Typ : Entity_Id) return Boolean;
    --  Subsidiary to Is_Fully_Initialized_Type. For an unconstrained type
    --  with discriminants whose default values are static, examine only the
@@ -13724,16 +13728,16 @@ package body Sem_Util is
    ----------------------
 
    function Is_Atomic_Object (N : Node_Id) return Boolean is
-      function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean;
-      --  Determine whether prefix Pref of an indexed component has atomic
-      --  components.
+      function Prefix_Has_Atomic_Components (P : Node_Id) return Boolean;
+      --  Determine whether prefix P has atomic components. This requires the
+      --  presence of an Atomic_Components aspect/pragma.
 
       ---------------------------------
       -- Prefix_Has_Atomic_Components --
       ---------------------------------
 
-      function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean is
-         Typ : constant Entity_Id := Etype (Pref);
+      function Prefix_Has_Atomic_Components (P : Node_Id) return Boolean is
+         Typ : constant Entity_Id := Etype (P);
 
       begin
          if Is_Access_Type (Typ) then
@@ -13742,8 +13746,8 @@ package body Sem_Util is
          elsif Has_Atomic_Components (Typ) then
             return True;
 
-         elsif Is_Entity_Name (Pref)
-           and then Has_Atomic_Components (Entity (Pref))
+         elsif Is_Entity_Name (P)
+           and then Has_Atomic_Components (Entity (P))
          then
             return True;
 
@@ -13758,18 +13762,18 @@ package body Sem_Util is
       if Is_Entity_Name (N) then
          return Is_Atomic_Object_Entity (Entity (N));
 
+      elsif Is_Atomic (Etype (N)) then
+         return True;
+
       elsif Nkind (N) = N_Indexed_Component then
-         return
-           Is_Atomic (Etype (N))
-             or else Prefix_Has_Atomic_Components (Prefix (N));
+         return Prefix_Has_Atomic_Components (Prefix (N));
 
       elsif Nkind (N) = N_Selected_Component then
-         return
-           Is_Atomic (Etype (N))
-             or else Is_Atomic (Entity (Selector_Name (N)));
-      end if;
+         return Is_Atomic (Entity (Selector_Name (N)));
 
-      return False;
+      else
+         return False;
+      end if;
    end Is_Atomic_Object;
 
    -----------------------------
@@ -13788,50 +13792,8 @@ package body Sem_Util is
    -----------------------------
 
    function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is
-      function Is_VFA_Object (N : Node_Id) return Boolean;
-      --  Determine whether arbitrary node N denotes a reference to an object
-      --  that is Volatile_Full_Access. Modeled on Is_Atomic_Object above.
-
-      function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean;
-      --  Determine whether arbitrary entity Id denotes an object that is
-      --  Volatile_Full_Access. Modeled on Is_Atomic_Object_Entity above.
-
-      ---------------------
-      --  Is_VFA_Object  --
-      ---------------------
-
-      function Is_VFA_Object (N : Node_Id) return Boolean is
-      begin
-         if Is_Entity_Name (N) then
-            return Is_VFA_Object_Entity (Entity (N));
-
-         elsif Nkind (N) = N_Indexed_Component then
-            return Is_Volatile_Full_Access (Etype (N));
-
-         elsif Nkind (N) = N_Selected_Component then
-            return
-              Is_Volatile_Full_Access (Etype (N))
-                or else Is_Volatile_Full_Access (Entity (Selector_Name (N)));
-         end if;
-
-         return False;
-      end Is_VFA_Object;
-
-      ----------------------------
-      --  Is_VFA_Object_Entity  --
-      ----------------------------
-
-      function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean is
-      begin
-         return
-           Is_Object (Id)
-             and then (Is_Volatile_Full_Access (Id)
-                         or else
-                       Is_Volatile_Full_Access (Etype (Id)));
-      end Is_VFA_Object_Entity;
-
    begin
-      return Is_Atomic_Object (N) or else Is_VFA_Object (N);
+      return Is_Atomic_Object (N) or else Is_Volatile_Full_Access_Object (N);
    end Is_Atomic_Or_VFA_Object;
 
    ----------------------
@@ -15479,6 +15441,78 @@ package body Sem_Util is
                              N_Generic_Subprogram_Declaration);
    end Is_Generic_Declaration_Or_Body;
 
+   ---------------------------
+   -- Is_Independent_Object --
+   ---------------------------
+
+   function Is_Independent_Object (N : Node_Id) return Boolean is
+      function Is_Independent_Object_Entity (Id : Entity_Id) return Boolean;
+      --  Determine whether arbitrary entity Id denotes an object that is
+      --  Independent.
+
+      function Prefix_Has_Independent_Components (P : Node_Id) return Boolean;
+      --  Determine whether prefix P has independent components. This requires
+      --  the presence of an Independent_Components aspect/pragma.
+
+      ------------------------------------
+      --  Is_Independent_Object_Entity  --
+      ------------------------------------
+
+      function Is_Independent_Object_Entity (Id : Entity_Id) return Boolean is
+      begin
+         return
+           Is_Object (Id)
+             and then (Is_Independent (Id)
+                        or else
+                      Is_Independent (Etype (Id)));
+      end Is_Independent_Object_Entity;
+
+      -------------------------------------
+      -- Prefix_Has_Independent_Components --
+      -------------------------------------
+
+      function Prefix_Has_Independent_Components (P : Node_Id) return Boolean
+      is
+         Typ : constant Entity_Id := Etype (P);
+
+      begin
+         if Is_Access_Type (Typ) then
+            return Has_Independent_Components (Designated_Type (Typ));
+
+         elsif Has_Independent_Components (Typ) then
+            return True;
+
+         elsif Is_Entity_Name (P)
+           and then Has_Independent_Components (Entity (P))
+         then
+            return True;
+
+         else
+            return False;
+         end if;
+      end Prefix_Has_Independent_Components;
+
+   --  Start of processing for Is_Independent_Object
+
+   begin
+      if Is_Entity_Name (N) then
+         return Is_Independent_Object_Entity (Entity (N));
+
+      elsif Is_Independent (Etype (N)) then
+         return True;
+
+      elsif Nkind (N) = N_Indexed_Component then
+         return Prefix_Has_Independent_Components (Prefix (N));
+
+      elsif Nkind (N) = N_Selected_Component then
+         return Prefix_Has_Independent_Components (Prefix (N))
+           or else Is_Independent (Entity (Selector_Name (N)));
+
+      else
+         return False;
+      end if;
+   end Is_Independent_Object;
+
    ----------------------------
    -- Is_Inherited_Operation --
    ----------------------------
@@ -17903,7 +17937,7 @@ package body Sem_Util is
             end if;
 
          else
-            if Is_Atomic (Etype (R)) or else Is_Atomic_Object (R) then
+            if Is_Atomic_Object (R) then
                return True;
             end if;
          end if;
@@ -18545,6 +18579,45 @@ package body Sem_Util is
         and then Scope (Scope (Scope (Root))) = Standard_Standard;
    end Is_Visibly_Controlled;
 
+   --------------------------------------
+   --  Is_Volatile_Full_Access_Object  --
+   --------------------------------------
+
+   function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean is
+      function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean;
+      --  Determine whether arbitrary entity Id denotes an object that is
+      --  Volatile_Full_Access.
+
+      ----------------------------
+      --  Is_VFA_Object_Entity  --
+      ----------------------------
+
+      function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean is
+      begin
+         return
+           Is_Object (Id)
+             and then (Is_Volatile_Full_Access (Id)
+                         or else
+                       Is_Volatile_Full_Access (Etype (Id)));
+      end Is_VFA_Object_Entity;
+
+   --  Start of processing for Is_Volatile_Full_Access_Object
+
+   begin
+      if Is_Entity_Name (N) then
+         return Is_VFA_Object_Entity (Entity (N));
+
+      elsif Is_Volatile_Full_Access (Etype (N)) then
+         return True;
+
+      elsif Nkind (N) = N_Selected_Component then
+         return Is_Volatile_Full_Access (Entity (Selector_Name (N)));
+
+      else
+         return False;
+      end if;
+   end Is_Volatile_Full_Access_Object;
+
    --------------------------
    -- Is_Volatile_Function --
    --------------------------
@@ -18580,18 +18653,32 @@ package body Sem_Util is
    ------------------------
 
    function Is_Volatile_Object (N : Node_Id) return Boolean is
-      function Is_Volatile_Prefix (N : Node_Id) return Boolean;
-      --  If prefix is an implicit dereference, examine designated type
+      function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean;
+      --  Determine whether arbitrary entity Id denotes an object that is
+      --  Volatile.
 
-      function Object_Has_Volatile_Components (N : Node_Id) return Boolean;
-      --  Determines if given object has volatile components
+      function Prefix_Has_Volatile_Components (P : Node_Id) return Boolean;
+      --  Determine whether prefix P has volatile components. This requires
+      --  the presence of a Volatile_Components aspect/pragma or that P be
+      --  itself a volatile object as per RM C.6(8).
 
-      ------------------------
-      -- Is_Volatile_Prefix --
-      ------------------------
+      ---------------------------------
+      --  Is_Volatile_Object_Entity  --
+      ---------------------------------
+
+      function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean is
+      begin
+         return
+           Is_Object (Id)
+             and then (Is_Volatile (Id) or else Is_Volatile (Etype (Id)));
+      end Is_Volatile_Object_Entity;
 
-      function Is_Volatile_Prefix (N : Node_Id) return Boolean is
-         Typ  : constant Entity_Id := Etype (N);
+      ------------------------------------
+      -- Prefix_Has_Volatile_Components --
+      ------------------------------------
+
+      function Prefix_Has_Volatile_Components (P : Node_Id) return Boolean is
+         Typ  : constant Entity_Id := Etype (P);
 
       begin
          if Is_Access_Type (Typ) then
@@ -18599,67 +18686,41 @@ package body Sem_Util is
                Dtyp : constant Entity_Id := Designated_Type (Typ);
 
             begin
-               return Is_Volatile (Dtyp)
-                 or else Has_Volatile_Components (Dtyp);
+               return Has_Volatile_Components (Dtyp)
+                 or else Is_Volatile (Dtyp);
             end;
 
-         else
-            return Object_Has_Volatile_Components (N);
-         end if;
-      end Is_Volatile_Prefix;
-
-      ------------------------------------
-      -- Object_Has_Volatile_Components --
-      ------------------------------------
-
-      function Object_Has_Volatile_Components (N : Node_Id) return Boolean is
-         Typ : constant Entity_Id := Etype (N);
-
-      begin
-         if Is_Volatile (Typ)
-           or else Has_Volatile_Components (Typ)
-         then
+         elsif Has_Volatile_Components (Typ) then
             return True;
 
-         elsif Is_Entity_Name (N)
-           and then (Has_Volatile_Components (Entity (N))
-                      or else Is_Volatile (Entity (N)))
+         elsif Is_Entity_Name (P)
+           and then Has_Volatile_Component (Entity (P))
          then
             return True;
 
-         elsif Nkind (N) = N_Indexed_Component
-           or else Nkind (N) = N_Selected_Component
-         then
-            return Is_Volatile_Prefix (Prefix (N));
+         elsif Is_Volatile_Object (P) then
+            return True;
 
          else
             return False;
          end if;
-      end Object_Has_Volatile_Components;
+      end Prefix_Has_Volatile_Components;
 
    --  Start of processing for Is_Volatile_Object
 
    begin
-      if Nkind (N) = N_Defining_Identifier then
-         return Is_Volatile (N) or else Is_Volatile (Etype (N));
-
-      elsif Nkind (N) = N_Expanded_Name then
-         return Is_Volatile_Object (Entity (N));
+      if Is_Entity_Name (N) then
+         return Is_Volatile_Object_Entity (Entity (N));
 
-      elsif Is_Volatile (Etype (N))
-        or else (Is_Entity_Name (N) and then Is_Volatile (Entity (N)))
-      then
+      elsif Is_Volatile (Etype (N)) then
          return True;
 
-      elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component)
-        and then Is_Volatile_Prefix (Prefix (N))
-      then
-         return True;
+      elsif Nkind (N) = N_Indexed_Component then
+         return Prefix_Has_Volatile_Components (Prefix (N));
 
-      elsif Nkind (N) = N_Selected_Component
-        and then Is_Volatile (Entity (Selector_Name (N)))
-      then
-         return True;
+      elsif Nkind (N) = N_Selected_Component then
+         return Prefix_Has_Volatile_Components (Prefix (N))
+           or else Is_Volatile (Entity (Selector_Name (N)));
 
       else
          return False;

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a665b5e9a309519ed12d91ea19294bc41138fc41..2882917bf9f6606f217e2e6f6f936df3b0f677fb 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1531,11 +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(7) and the crucial remark in C.6(8).
-
-   function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean;
-   --  Determine whether arbitrary entity Id denotes an atomic object as per
-   --  Ada RM C.6(7).
+   --  object as per RM C.6(7) and the crucial remark in RM C.6(8).
 
    function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean;
    --  Determine whether arbitrary node N denotes a reference to an object
@@ -1749,6 +1745,10 @@ package Sem_Util is
    --  Determine whether arbitrary declaration Decl denotes a generic package,
    --  a generic subprogram or a generic body.
 
+   function Is_Independent_Object (N : Node_Id) return Boolean;
+   --  Determine whether arbitrary node N denotes a reference to an independent
+   --  object as per RM C.6(8).
+
    function Is_Inherited_Operation (E : Entity_Id) return Boolean;
    --  E is a subprogram. Return True is E is an implicit operation inherited
    --  by a derived type declaration.
@@ -1996,7 +1996,7 @@ package Sem_Util is
 
    function Is_Subcomponent_Of_Atomic_Object (N : Node_Id) return Boolean;
    --  Determine whether arbitrary node N denotes a reference to a subcomponent
-   --  of an atomic object as per Ada RM C.6(7).
+   --  of an atomic object as per RM C.6(7).
 
    function Is_Subprogram_Contract_Annotation (Item : Node_Id) return Boolean;
    --  Determine whether aspect specification or pragma Item is one of the
@@ -2095,16 +2095,20 @@ package Sem_Util is
    --  Initialize/Adjust/Finalize subprogram does not override the inherited
    --  one.
 
+   function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean;
+   --  Determine whether arbitrary node N denotes a reference to an object
+   --  which is Volatile_Full_Access.
+
    function Is_Volatile_Function (Func_Id : Entity_Id) return Boolean;
    --  Determine whether [generic] function Func_Id is subject to enabled
    --  pragma Volatile_Function. Protected functions are treated as volatile
    --  (SPARK RM 7.1.2).
 
    function Is_Volatile_Object (N : Node_Id) return Boolean;
-   --  Determines if the given node denotes an volatile object in the sense of
-   --  the legality checks described in RM C.6(12). Note that the test here is
-   --  for something actually declared as volatile, not for an object that gets
-   --  treated as volatile (see Einfo.Treat_As_Volatile).
+   --  Determine whether arbitrary node N denotes a reference to a volatile
+   --  object as per RM C.6(8). Note that the test here is for something that
+   --  is actually declared as volatile, not for an object that gets treated
+   --  as volatile (see Einfo.Treat_As_Volatile).
 
    generic
       with procedure Handle_Parameter (Formal : Entity_Id; Actual : Node_Id);