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

Message ID 20191216103825.GA39291@adacore.com
State New
Headers show
Series
  • [Ada] Implement new legality rules introduced in C.6(13) by AI12-0128
Related show

Commit Message

Pierre-Marie de Rodat Dec. 16, 2019, 10:38 a.m.
This implements the new 4 legality rules added to C.6(13) by AI12-0128
and pertaining to nonatomic subcomponents of atomic types and objects.

This also implements the counterpart of the last 2 rules for the GNAT
specific aspect/pragma Volatile_Full_Access (they were only partially
implemented before for it).

Finally this beefs up the error messages given for related legality
rules in C.6(12) and adds explicit references to these RM clauses.

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

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.

Patch

--- gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ 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:
 

--- gcc/ada/freeze.adb
+++ 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

--- gcc/ada/gnat_rm.texi
+++ 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}

--- gcc/ada/sem_ch12.adb
+++ 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

--- gcc/ada/sem_prag.adb
+++ 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;

--- gcc/ada/sem_res.adb
+++ 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;

--- gcc/ada/sem_util.adb
+++ 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 --
    ---------------------------------------

--- gcc/ada/sem_util.ads
+++ 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: