[Ada] Implement new legality rules introduced in C.6(13) by AI12-0128

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

gcc/ada/

	* doc/gnat_rm/implementation_defined_pragmas.rst (VFA): Document
	extension of the no-aliasing rule to any subcomponent.
	* freeze.adb (Freeze_Object_Declaration): Small comment tweak.
	(Freeze_Record_Type): Do not deal with delayed aspect
	specifications for components here but...
	(Freeze_Entity): ...here instead.
	* sem_ch12.adb (Instantiate_Object): Improve wording of errors
	given for legality rules in C.6(12) and implement the new rule
	in C.6(13).
	* sem_res.adb (Resolve_Actuals): Likewise.
	* sem_prag.adb (Check_Atomic_VFA): New procedure implementing
	the new legality rules in C.6(13).
	(Process_Atomic_Independent_Shared_Volatile): Call
	Check_Atomic_VFA to check the legality rules.  Factor out code
	marking types into...
	(Mark_Type): ...this new procedure.
	(Check_VFA_Conflicts): Do not check the legality rules here.
	(Pragma_Atomic_Components): Call Check_Atomic_VFA on component
	type.
	* sem_util.ads (Is_Subcomponent_Of_Atomic_Object): Declare.
	* sem_util.adb (Is_Subcomponent_Of_Atomic_Object): New
	predicate.
	* gnat_rm.texi: Regenerate.

From-SVN: r279412

9 files changed, 394 insertions, 161 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1fea353..58517e6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+2019-12-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* doc/gnat_rm/implementation_defined_pragmas.rst (VFA): Document
+	extension of the no-aliasing rule to any subcomponent.
+	* freeze.adb (Freeze_Object_Declaration): Small comment tweak.
+	(Freeze_Record_Type): Do not deal with delayed aspect
+	specifications for components here but...
+	(Freeze_Entity): ...here instead.
+	* sem_ch12.adb (Instantiate_Object): Improve wording of errors
+	given for legality rules in C.6(12) and implement the new rule
+	in C.6(13).
+	* sem_res.adb (Resolve_Actuals): Likewise.
+	* sem_prag.adb (Check_Atomic_VFA): New procedure implementing
+	the new legality rules in C.6(13).
+	(Process_Atomic_Independent_Shared_Volatile): Call
+	Check_Atomic_VFA to check the legality rules.  Factor out code
+	marking types into...
+	(Mark_Type): ...this new procedure.
+	(Check_VFA_Conflicts): Do not check the legality rules here.
+	(Pragma_Atomic_Components): Call Check_Atomic_VFA on component
+	type.
+	* sem_util.ads (Is_Subcomponent_Of_Atomic_Object): Declare.
+	* sem_util.adb (Is_Subcomponent_Of_Atomic_Object): New
+	predicate.
+	* gnat_rm.texi: Regenerate.
+
 2019-12-13  Gary Dismukes  <dismukes@adacore.com>
 
 	* doc/gnat_rm/implementation_defined_pragmas.rst: Minor
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 6d0bdd8..42087ad 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -7443,7 +7443,7 @@ It is not permissible to specify ``Atomic`` and ``Volatile_Full_Access`` for
 the same type or object.
 
 It is not permissible to specify ``Volatile_Full_Access`` for a composite
-(record or array) type or object that has at least one ``Aliased`` component.
+(record or array) type or object that has an ``Aliased`` subcomponent.
 
 .. _Pragma-Volatile_Function:
 
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index add4153..de5f8f7 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3569,7 +3569,8 @@ package body Freeze is
             Error_Msg_N ("\??use explicit size clause to set size", E);
          end if;
 
-         --  Declaring a too-big array in disabled ghost code is OK
+         --  Declaring too big an array in disabled ghost code is OK
+
          if Is_Array_Type (Typ) and then not Is_Ignored_Ghost_Entity (E) then
             Check_Large_Modular_Array (Typ);
          end if;
@@ -3998,11 +3999,6 @@ package body Freeze is
          --  clause (used to warn about useless Bit_Order pragmas, and also
          --  to detect cases where Implicit_Packing may have an effect).
 
-         Rec_Pushed : Boolean := False;
-         --  Set True if the record type scope Rec has been pushed on the scope
-         --  stack. Needed for the analysis of delayed aspects specified to the
-         --  components of Rec.
-
          Sized_Component_Total_RM_Size : Uint := Uint_0;
          --  Accumulates total RM_Size values of all sized components. Used
          --  for processing of Implicit_Packing.
@@ -4141,47 +4137,6 @@ package body Freeze is
       --  Start of processing for Freeze_Record_Type
 
       begin
-         --  Deal with delayed aspect specifications for components. The
-         --  analysis of the aspect is required to be delayed to the freeze
-         --  point, thus we analyze the pragma or attribute definition
-         --  clause in the tree at this point. We also analyze the aspect
-         --  specification node at the freeze point when the aspect doesn't
-         --  correspond to pragma/attribute definition clause.
-
-         Comp := First_Entity (Rec);
-         while Present (Comp) loop
-            if Ekind (Comp) = E_Component
-              and then Has_Delayed_Aspects (Comp)
-            then
-               if not Rec_Pushed then
-                  Push_Scope (Rec);
-                  Rec_Pushed := True;
-
-                  --  The visibility to the discriminants must be restored in
-                  --  order to properly analyze the aspects.
-
-                  if Has_Discriminants (Rec) then
-                     Install_Discriminants (Rec);
-                  end if;
-               end if;
-
-               Analyze_Aspects_At_Freeze_Point (Comp);
-            end if;
-
-            Next_Entity (Comp);
-         end loop;
-
-         --  Pop the scope if Rec scope has been pushed on the scope stack
-         --  during the delayed aspect analysis process.
-
-         if Rec_Pushed then
-            if Has_Discriminants (Rec) then
-               Uninstall_Discriminants (Rec);
-            end if;
-
-            Pop_Scope;
-         end if;
-
          --  Freeze components and embedded subtypes
 
          Comp := First_Entity (Rec);
@@ -5492,6 +5447,56 @@ package body Freeze is
       --  In addition, a derived type may have inherited aspects that were
       --  delayed in the parent, so these must also be captured now.
 
+      --  For a record type, we deal with the delayed aspect specifications on
+      --  components first, which is consistent with the non-delayed case and
+      --  makes it possible to have a single processing to detect conflicts.
+
+      if Is_Record_Type (E) then
+         declare
+            Comp : Entity_Id;
+
+            Rec_Pushed : Boolean := False;
+            --  Set True if the record type E has been pushed on the scope
+            --  stack. Needed for the analysis of delayed aspects specified
+            --  to the components of Rec.
+
+         begin
+            Comp := First_Entity (E);
+            while Present (Comp) loop
+               if Ekind (Comp) = E_Component
+                 and then Has_Delayed_Aspects (Comp)
+               then
+                  if not Rec_Pushed then
+                     Push_Scope (E);
+                     Rec_Pushed := True;
+
+                     --  The visibility to the discriminants must be restored
+                     --  in order to properly analyze the aspects.
+
+                     if Has_Discriminants (E) then
+                        Install_Discriminants (E);
+                     end if;
+                  end if;
+
+                  Analyze_Aspects_At_Freeze_Point (Comp);
+               end if;
+
+               Next_Entity (Comp);
+            end loop;
+
+            --  Pop the scope if Rec scope has been pushed on the scope stack
+            --  during the delayed aspect analysis process.
+
+            if Rec_Pushed then
+               if Has_Discriminants (E) then
+                  Uninstall_Discriminants (E);
+               end if;
+
+               Pop_Scope;
+            end if;
+         end;
+      end if;
+
       if Has_Delayed_Aspects (E)
         or else May_Inherit_Delayed_Rep_Aspects (E)
       then
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index f7c2923..6476591 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -8949,7 +8949,7 @@ It is not permissible to specify @code{Atomic} and @code{Volatile_Full_Access} f
 the same type or object.
 
 It is not permissible to specify @code{Volatile_Full_Access} for a composite
-(record or array) type or object that has at least one @code{Aliased} component.
+(record or array) type or object that has an @code{Aliased} subcomponent.
 
 @node Pragma Volatile_Function,Pragma Warning_As_Error,Pragma Volatile_Full_Access,Implementation Defined Pragmas
 @anchor{gnat_rm/implementation_defined_pragmas id56}@anchor{11e}@anchor{gnat_rm/implementation_defined_pragmas pragma-volatile-function}@anchor{11f}
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 6932368..d405297 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11111,19 +11111,36 @@ package body Sem_Ch12 is
 
          Note_Possible_Modification (Actual, Sure => True);
 
-         --  Check for instantiation of atomic/volatile actual for
-         --  non-atomic/volatile formal (RM C.6 (12)).
+         --  Check for instantiation with atomic/volatile object actual for
+         --  nonatomic/nonvolatile formal (RM C.6 (12)).
 
          if Is_Atomic_Object (Actual) and then not Is_Atomic (Orig_Ftyp) then
-            Error_Msg_N
-              ("cannot instantiate non-atomic formal object "
-               & "with atomic actual", Actual);
+            Error_Msg_NE
+              ("cannot instantiate nonatomic formal & of mode in out",
+               Actual, Gen_Obj);
+            Error_Msg_N ("\with atomic object actual (RM C.6(12))", Actual);
 
          elsif Is_Volatile_Object (Actual) and then not Is_Volatile (Orig_Ftyp)
          then
+            Error_Msg_NE
+              ("cannot instantiate nonvolatile formal & of mode in out",
+               Actual, Gen_Obj);
+            Error_Msg_N ("\with volatile object actual (RM C.6(12))", Actual);
+         end if;
+
+         --  Check for instantiation on nonatomic subcomponent of an atomic
+         --  object in Ada 2020 (RM C.6 (13)).
+
+         if Ada_Version >= Ada_2020
+            and then Is_Subcomponent_Of_Atomic_Object (Actual)
+            and then not Is_Atomic_Object (Actual)
+         then
+            Error_Msg_NE
+              ("cannot instantiate formal & of mode in out with actual",
+               Actual, Gen_Obj);
             Error_Msg_N
-              ("cannot instantiate non-volatile formal object "
-               & "with volatile actual", Actual);
+              ("\nonatomic subcomponent of atomic object (RM C.6(13))",
+               Actual);
          end if;
 
       --  Formal in-parameter
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index db4b1b4..1b07a84 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3927,6 +3927,10 @@ package body Sem_Prag is
       procedure Check_At_Most_N_Arguments (N : Nat);
       --  Check there are no more than N arguments present
 
+      procedure Check_Atomic_VFA (E : Entity_Id; VFA : Boolean);
+      --  Apply legality checks to type or object E subject to an Atomic aspect
+      --  in Ada 2020 (RM C.6(13)) or to a Volatile_Full_Access aspect.
+
       procedure Check_Component
         (Comp            : Node_Id;
          UU_Typ          : Entity_Id;
@@ -5680,6 +5684,165 @@ package body Sem_Prag is
          end if;
       end Check_At_Most_N_Arguments;
 
+      ------------------------
+      --  Check_Atomic_VFA  --
+      ------------------------
+
+      procedure Check_Atomic_VFA (E : Entity_Id; VFA : Boolean) is
+
+         Aliased_Subcomponent : exception;
+         --  Exception raised if an aliased subcomponent is found in E
+
+         Independent_Subcomponent : exception;
+         --  Exception raised if an independent subcomponent is found in E
+
+         procedure Check_Subcomponents (Typ : Entity_Id);
+         --  Apply checks to subcomponents for Atomic and Volatile_Full_Access
+
+         -------------------------
+         -- Check_Subcomponents --
+         -------------------------
+
+         procedure Check_Subcomponents (Typ : Entity_Id) is
+            Comp : Entity_Id;
+
+         begin
+            if Is_Array_Type (Typ) then
+               Comp := Component_Type (Typ);
+
+               --  For Atomic we accept any atomic subcomponents
+
+               if not VFA
+                 and then (Has_Atomic_Components (Typ)
+                            or else Is_Atomic (Comp))
+               then
+                  null;
+
+               --  Give an error if the components are aliased
+
+               elsif Has_Aliased_Components (Typ)
+                 or else Is_Aliased (Comp)
+               then
+                  raise Aliased_Subcomponent;
+
+               --  For VFA we accept non-aliased VFA subcomponents
+
+               elsif VFA
+                 and then Is_Volatile_Full_Access (Comp)
+               then
+                  null;
+
+               --  Give an error if the components are independent
+
+               elsif Has_Independent_Components (Typ)
+                  or else Is_Independent (Comp)
+               then
+                  raise Independent_Subcomponent;
+               end if;
+
+               --  Recurse on the component type
+
+               Check_Subcomponents (Comp);
+
+            --  Note: Has_Aliased_Components, like Has_Atomic_Components,
+            --  and Has_Independent_Components, applies only to arrays.
+            --  However, this flag does not have a corresponding pragma, so
+            --  perhaps it should be possible to apply it to record types as
+            --  well. Should this be done ???
+
+            elsif Is_Record_Type (Typ) then
+               --  It is possible to have an aliased discriminant, so they
+               --  must be checked along with normal components.
+
+               Comp := First_Component_Or_Discriminant (Typ);
+               while Present (Comp) loop
+
+                  --  For Atomic we accept any atomic subcomponents
+
+                  if not VFA
+                    and then (Is_Atomic (Comp)
+                               or else Is_Atomic (Etype (Comp)))
+                  then
+                     null;
+
+                  --  Give an error if the component is aliased
+
+                  elsif Is_Aliased (Comp)
+                    or else Is_Aliased (Etype (Comp))
+                  then
+                     raise Aliased_Subcomponent;
+
+                  --  For VFA we accept non-aliased VFA subcomponents
+
+                  elsif VFA
+                    and then (Is_Volatile_Full_Access (Comp)
+                               or else Is_Volatile_Full_Access (Etype (Comp)))
+                  then
+                     null;
+
+                  --  Give an error if the component is independent
+
+                  elsif Is_Independent (Comp)
+                     or else Is_Independent (Etype (Comp))
+                  then
+                     raise Independent_Subcomponent;
+                  end if;
+
+                  --  Recurse on the component type
+
+                  Check_Subcomponents (Etype (Comp));
+
+                  Next_Component_Or_Discriminant (Comp);
+               end loop;
+            end if;
+         end Check_Subcomponents;
+
+         Typ : Entity_Id;
+
+      begin
+         --  Fetch the type in case we are dealing with an object or component
+
+         if Is_Type (E) then
+            Typ := E;
+         else
+            pragma Assert (Is_Object (E)
+              or else
+                Nkind (Declaration_Node (E)) = N_Component_Declaration);
+
+            Typ := Etype (E);
+         end if;
+
+         --  Check all the subcomponents of the type recursively, if any
+
+         Check_Subcomponents (Typ);
+
+      exception
+         when Aliased_Subcomponent =>
+            if VFA then
+               Error_Pragma
+                 ("cannot apply Volatile_Full_Access with aliased "
+                  & "subcomponent ");
+            else
+               Error_Pragma
+                 ("cannot apply Atomic with aliased subcomponent "
+                  & "(RM C.6(13))");
+            end if;
+
+         when Independent_Subcomponent =>
+            if VFA then
+               Error_Pragma
+                 ("cannot apply Volatile_Full_Access with independent "
+                  & "subcomponent ");
+            else
+               Error_Pragma
+                 ("cannot apply Atomic with independent subcomponent "
+                  & "(RM C.6(13))");
+            end if;
+
+         when others =>
+            raise Program_Error;
+      end Check_Atomic_VFA;
+
       ---------------------
       -- Check_Component --
       ---------------------
@@ -7260,13 +7423,16 @@ package body Sem_Prag is
 
       procedure Process_Atomic_Independent_Shared_Volatile is
          procedure Check_VFA_Conflicts (Ent : Entity_Id);
-         --  Apply additional checks for the GNAT pragma Volatile_Full_Access
+         --  Check that Volatile_Full_Access and VFA do not conflict
 
          procedure Mark_Component_Or_Object (Ent : Entity_Id);
-         --  Appropriately set flags on the given entity (either an array or
+         --  Appropriately set flags on the given entity, either an array or
          --  record component, or an object declaration) according to the
          --  current pragma.
 
+         procedure Mark_Type (Ent : Entity_Id);
+         --  Appropriately set flags on the given entity, a type
+
          procedure Set_Atomic_VFA (Ent : Entity_Id);
          --  Set given type as Is_Atomic or Is_Volatile_Full_Access. Also, if
          --  no explicit alignment was given, set alignment to unknown, since
@@ -7282,10 +7448,7 @@ package body Sem_Prag is
             Typ  : Entity_Id;
 
             VFA_And_Atomic : Boolean := False;
-            --  Set True if atomic component present
-
-            VFA_And_Aliased : Boolean := False;
-            --  Set True if aliased component present
+            --  Set True if both VFA and Atomic present
 
          begin
             --  Fetch the type in case we are dealing with an object or
@@ -7343,48 +7506,6 @@ package body Sem_Prag is
                      & "entity");
                end if;
             end if;
-
-            --  Check for the application of VFA to an entity that has aliased
-            --  components.
-
-            if Prag_Id = Pragma_Volatile_Full_Access then
-               if Is_Array_Type (Typ)
-                 and then Has_Aliased_Components (Typ)
-               then
-                  VFA_And_Aliased := True;
-
-               --  Note: Has_Aliased_Components, like Has_Atomic_Components,
-               --  and Has_Independent_Components, applies only to arrays.
-               --  However, this flag does not have a corresponding pragma, so
-               --  perhaps it should be possible to apply it to record types as
-               --  well. Should this be done ???
-
-               elsif Is_Record_Type (Typ) then
-                  --  It is possible to have an aliased discriminant, so they
-                  --  must be checked along with normal components.
-
-                  Comp := First_Component_Or_Discriminant (Typ);
-                  while Present (Comp) loop
-                     if Is_Aliased (Comp)
-                       or else Is_Aliased (Etype (Comp))
-                     then
-                        VFA_And_Aliased := True;
-                        Check_SPARK_05_Restriction
-                          ("aliased is not allowed", Comp);
-
-                        exit;
-                     end if;
-
-                     Next_Component_Or_Discriminant (Comp);
-                  end loop;
-               end if;
-
-               if VFA_And_Aliased then
-                  Error_Pragma
-                    ("cannot apply Volatile_Full_Access (aliased component "
-                     & "present)");
-               end if;
-            end if;
          end Check_VFA_Conflicts;
 
          ------------------------------
@@ -7432,6 +7553,66 @@ package body Sem_Prag is
             end if;
          end Mark_Component_Or_Object;
 
+         ---------------
+         -- Mark_Type --
+         ---------------
+
+         procedure Mark_Type (Ent : Entity_Id) is
+         begin
+            --  Attribute belongs on the base type. If the view of the type is
+            --  currently private, it also belongs on the underlying type.
+
+            if Prag_Id = Pragma_Atomic
+              or else Prag_Id = Pragma_Shared
+              or else Prag_Id = Pragma_Volatile_Full_Access
+            then
+               Set_Atomic_VFA (Ent);
+               Set_Atomic_VFA (Base_Type (Ent));
+               Set_Atomic_VFA (Underlying_Type (Ent));
+            end if;
+
+            --  Atomic/Shared/Volatile_Full_Access imply Independent
+
+            if Prag_Id /= Pragma_Volatile then
+               Set_Is_Independent (Ent);
+               Set_Is_Independent (Base_Type (Ent));
+               Set_Is_Independent (Underlying_Type (Ent));
+
+               if Prag_Id = Pragma_Independent then
+                  Record_Independence_Check (N, Base_Type (Ent));
+               end if;
+            end if;
+
+            --  Atomic/Shared/Volatile_Full_Access imply Volatile
+
+            if Prag_Id /= Pragma_Independent then
+               Set_Is_Volatile (Ent);
+               Set_Is_Volatile (Base_Type (Ent));
+               Set_Is_Volatile (Underlying_Type (Ent));
+
+               Set_Treat_As_Volatile (Ent);
+               Set_Treat_As_Volatile (Underlying_Type (Ent));
+            end if;
+
+            --  Apply Volatile to the composite type's individual components,
+            --  (RM C.6(8/3)).
+
+            if Prag_Id = Pragma_Volatile
+              and then Is_Record_Type (Etype (Ent))
+            then
+               declare
+                  Comp : Entity_Id;
+               begin
+                  Comp := First_Component (Ent);
+                  while Present (Comp) loop
+                     Mark_Component_Or_Object (Comp);
+
+                     Next_Component (Comp);
+                  end loop;
+               end;
+            end if;
+         end Mark_Type;
+
          --------------------
          -- Set_Atomic_VFA --
          --------------------
@@ -7494,58 +7675,7 @@ package body Sem_Prag is
                Check_First_Subtype (Arg1);
             end if;
 
-            --  Attribute belongs on the base type. If the view of the type is
-            --  currently private, it also belongs on the underlying type.
-
-            if Prag_Id = Pragma_Atomic
-              or else Prag_Id = Pragma_Shared
-              or else Prag_Id = Pragma_Volatile_Full_Access
-            then
-               Set_Atomic_VFA (E);
-               Set_Atomic_VFA (Base_Type (E));
-               Set_Atomic_VFA (Underlying_Type (E));
-            end if;
-
-            --  Atomic/Shared/Volatile_Full_Access imply Independent
-
-            if Prag_Id /= Pragma_Volatile then
-               Set_Is_Independent (E);
-               Set_Is_Independent (Base_Type (E));
-               Set_Is_Independent (Underlying_Type (E));
-
-               if Prag_Id = Pragma_Independent then
-                  Record_Independence_Check (N, Base_Type (E));
-               end if;
-            end if;
-
-            --  Atomic/Shared/Volatile_Full_Access imply Volatile
-
-            if Prag_Id /= Pragma_Independent then
-               Set_Is_Volatile (E);
-               Set_Is_Volatile (Base_Type (E));
-               Set_Is_Volatile (Underlying_Type (E));
-
-               Set_Treat_As_Volatile (E);
-               Set_Treat_As_Volatile (Underlying_Type (E));
-            end if;
-
-            --  Apply Volatile to the composite type's individual components,
-            --  (RM C.6(8/3)).
-
-            if Prag_Id = Pragma_Volatile
-              and then Is_Record_Type (Etype (E))
-            then
-               declare
-                  Comp : Entity_Id;
-               begin
-                  Comp := First_Component (E);
-                  while Present (Comp) loop
-                     Mark_Component_Or_Object (Comp);
-
-                     Next_Component (Comp);
-                  end loop;
-               end;
-            end if;
+            Mark_Type (E);
 
          --  Deal with the case where the pragma/attribute applies to a
          --  component or object declaration.
@@ -7559,15 +7689,27 @@ package body Sem_Prag is
             end if;
 
             Mark_Component_Or_Object (E);
+
+         --  In other cases give an error
+
          else
             Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
          end if;
 
-         --  Perform the checks needed to assure the proper use of the GNAT
-         --  pragma Volatile_Full_Access.
+         --  Check that Volatile_Full_Access and Atomic do not conflict
 
          Check_VFA_Conflicts (E);
 
+         --  Check for the application of Atomic or Volatile_Full_Access to
+         --  an entity that has [nonatomic] aliased, or else specified to be
+         --  independently addressable, subcomponents.
+
+         if (Prag_Id = Pragma_Atomic and then Ada_Version >= Ada_2020)
+           or else Prag_Id = Pragma_Volatile_Full_Access
+         then
+            Check_Atomic_VFA (E, VFA => Prag_Id = Pragma_Volatile_Full_Access);
+         end if;
+
          --  The following check is only relevant when SPARK_Mode is on as
          --  this is not a standard Ada legality rule. Pragma Volatile can
          --  only apply to a full type declaration or an object declaration
@@ -13944,6 +14086,9 @@ package body Sem_Prag is
                --  Atomic implies both Independent and Volatile
 
                if Prag_Id = Pragma_Atomic_Components then
+                  if Ada_Version >= Ada_2020 then
+                     Check_Atomic_VFA (Component_Type (E), VFA => False);
+                  end if;
                   Set_Has_Atomic_Components (E);
                   Set_Has_Independent_Components (E);
                end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 1c5ae36..2628a5a 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4715,7 +4715,7 @@ package body Sem_Res is
                end if;
             end if;
 
-            --  Check bad case of atomic/volatile argument (RM C.6(12))
+            --  Check illegal cases of atomic/volatile actual (RM C.6(12,13))
 
             if (Is_By_Reference_Type (Etype (F)) or else Is_Aliased (F))
               and then Comes_From_Source (N)
@@ -4724,14 +4724,30 @@ package body Sem_Res is
                  and then not Is_Atomic (Etype (F))
                then
                   Error_Msg_NE
-                    ("cannot pass atomic argument to non-atomic formal&",
+                    ("cannot pass atomic object to nonatomic formal&",
                      A, F);
+                  Error_Msg_N
+                    ("\which is passed by reference (RM C.6(12))", A);
 
                elsif Is_Volatile_Object (A)
                  and then not Is_Volatile (Etype (F))
                then
                   Error_Msg_NE
-                    ("cannot pass volatile argument to non-volatile formal&",
+                    ("cannot pass volatile object to nonvolatile formal&",
+                     A, F);
+                  Error_Msg_N
+                    ("\which is passed by reference (RM C.6(12))", A);
+               end if;
+
+               if Ada_Version >= Ada_2020
+                 and then Is_Subcomponent_Of_Atomic_Object (A)
+                 and then not Is_Atomic_Object (A)
+               then
+                  Error_Msg_N
+                    ("cannot pass nonatomic subcomponent of atomic object",
+                     A);
+                  Error_Msg_NE
+                    ("\to formal & which is passed by reference (RM C.6(13))",
                      A, F);
                end if;
             end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 30a2273..7ed717d 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -17844,6 +17844,26 @@ package body Sem_Util is
           or else Nkind (N) = N_Procedure_Call_Statement;
    end Is_Statement;
 
+   ----------------------------------------
+   --  Is_Subcomponent_Of_Atomic_Object  --
+   ----------------------------------------
+
+   function Is_Subcomponent_Of_Atomic_Object (N : Node_Id) return Boolean is
+      R : Node_Id;
+
+   begin
+      R := Get_Referenced_Object (N);
+      while Nkind_In (R, N_Indexed_Component, N_Selected_Component, N_Slice)
+      loop
+         R := Get_Referenced_Object (Prefix (R));
+         if Is_Atomic_Object (R) then
+            return True;
+         end if;
+      end loop;
+
+      return False;
+   end Is_Subcomponent_Of_Atomic_Object;
+
    ---------------------------------------
    -- Is_Subprogram_Contract_Annotation --
    ---------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c354d7e..c156651 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1996,6 +1996,10 @@ package Sem_Util is
    --  the N_Statement_Other_Than_Procedure_Call subtype from Sinfo).
    --  Note that a label is *not* a statement, and will return False.
 
+   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).
+
    function Is_Subprogram_Contract_Annotation (Item : Node_Id) return Boolean;
    --  Determine whether aspect specification or pragma Item is one of the
    --  following subprogram contract annotations: