[Ada] Fix couple of oversights in the implementation of AI12-0128

--- gcc/ada/gcc-interface/trans.c
+++ gcc/ada/gcc-interface/trans.c
@@ -3976,7 +3976,7 @@  Loop_Statement_to_gnu (Node_Id gnat_node)
   return gnu_result;
 }
 
-/* This page implements a form of Named Return Value optimization modelled
+/* This page implements a form of Named Return Value optimization modeled
    on the C++ optimization of the same name.  The main difference is that
    we disregard any semantical considerations when applying it here, the
    counterpart being that we don't try to apply it to semantically loaded
@@ -4792,7 +4792,13 @@  Subprogram_Body_to_gnu (Node_Id gnat_node)
     rest_of_subprog_body_compilation (gnu_subprog_decl);
 }
 
-/* Return true if GNAT_NODE references an Atomic entity.  */
+/* The type of an atomic access.  */
+
+typedef enum { NOT_ATOMIC, SIMPLE_ATOMIC, OUTER_ATOMIC } atomic_acces_t;
+
+/* Return true if GNAT_NODE references an Atomic entity.  This is modeled on
+   the Is_Atomic_Object predicate of the front-end, but additionally handles
+   explicit dereferences.  */
 
 static bool
 node_is_atomic (Node_Id gnat_node)
@@ -4809,17 +4815,14 @@  node_is_atomic (Node_Id gnat_node)
       return Is_Atomic (gnat_entity) || Is_Atomic (Etype (gnat_entity));
 
     case N_Selected_Component:
-      gnat_entity = Entity (Selector_Name (gnat_node));
-      return Is_Atomic (gnat_entity) || Is_Atomic (Etype (gnat_entity));
+      return Is_Atomic (Etype (gnat_node))
+	     || Is_Atomic (Entity (Selector_Name (gnat_node)));
 
     case N_Indexed_Component:
-      if (Has_Atomic_Components (Etype (Prefix (gnat_node))))
-	return true;
-      if (Is_Entity_Name (Prefix (gnat_node))
-	  && Has_Atomic_Components (Entity (Prefix (gnat_node))))
-	return true;
-
-      /* ... fall through ... */
+      return Is_Atomic (Etype (gnat_node))
+	     || Has_Atomic_Components (Etype (Prefix (gnat_node)))
+	     || (Is_Entity_Name (Prefix (gnat_node))
+		 && Has_Atomic_Components (Entity (Prefix (gnat_node))));
 
     case N_Explicit_Dereference:
       return Is_Atomic (Etype (gnat_node));
@@ -4831,10 +4834,12 @@  node_is_atomic (Node_Id gnat_node)
   return false;
 }
 
-/* Return true if GNAT_NODE references a Volatile_Full_Access entity.  */
+/* 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.  */
 
 static bool
-node_has_volatile_full_access (Node_Id gnat_node)
+node_is_volatile_full_access (Node_Id gnat_node)
 {
   Entity_Id gnat_entity;
 
@@ -4849,9 +4854,8 @@  node_has_volatile_full_access (Node_Id gnat_node)
 	     || Is_Volatile_Full_Access (Etype (gnat_entity));
 
     case N_Selected_Component:
-      gnat_entity = Entity (Selector_Name (gnat_node));
-      return Is_Volatile_Full_Access (gnat_entity)
-	     || Is_Volatile_Full_Access (Etype (gnat_entity));
+      return Is_Volatile_Full_Access (Etype (gnat_node))
+	     || Is_Volatile_Full_Access (Entity (Selector_Name (gnat_node)));
 
     case N_Indexed_Component:
     case N_Explicit_Dereference:
@@ -4864,73 +4868,42 @@  node_has_volatile_full_access (Node_Id gnat_node)
   return false;
 }
 
-/* Strip any type conversion on GNAT_NODE and return the result.  */
+/* Return true if GNAT_NODE references a component of a larger object.  */
 
-static Node_Id
-gnat_strip_type_conversion (Node_Id gnat_node)
+static inline bool
+node_is_component (Node_Id gnat_node)
 {
-  Node_Kind kind = Nkind (gnat_node);
-
-  if (kind == N_Type_Conversion || kind == N_Unchecked_Type_Conversion)
-    gnat_node = Expression (gnat_node);
-
-  return gnat_node;
+  const Node_Kind k = Nkind (gnat_node);
+  return
+    (k == N_Indexed_Component || k == N_Selected_Component || k == N_Slice);
 }
 
-/* Return true if GNAT_NODE requires outer atomic access, i.e. atomic access
-   of an object of which GNAT_NODE is a component.  */
-
-static bool
-outer_atomic_access_required_p (Node_Id gnat_node)
-{
-  gnat_node = gnat_strip_type_conversion (gnat_node);
-
-  while (true)
-    {
-      switch (Nkind (gnat_node))
-	{
-	case N_Identifier:
-	case N_Expanded_Name:
-	  if (No (Renamed_Object (Entity (gnat_node))))
-	    return false;
-	  gnat_node
-	    = gnat_strip_type_conversion (Renamed_Object (Entity (gnat_node)));
-	  break;
+/* Compute whether GNAT_NODE requires atomic access and set TYPE to the type
+   of access and SYNC according to the associated synchronization setting.
 
-	case N_Indexed_Component:
-	case N_Selected_Component:
-	case N_Slice:
-	  gnat_node = gnat_strip_type_conversion (Prefix (gnat_node));
-	  if (node_has_volatile_full_access (gnat_node))
-	    return true;
-	  break;
+   We implement 3 different semantics of atomicity in this function:
 
-	default:
-	  return false;
-	}
-    }
-
-  gcc_unreachable ();
-}
+     1. the Ada 95/2005/2012 semantics of the Atomic aspect/pragma,
+     2. the Ada 2020 semantics of the Atomic aspect/pragma,
+     3. the semantics of the Volatile_Full_Access GNAT aspect/pragma.
 
-/* Return true if GNAT_NODE requires atomic access and set SYNC according to
-   the associated synchronization setting.  */
+  They are mutually exclusive and the FE should have rejected conflicts.  */
 
-static bool
-atomic_access_required_p (Node_Id gnat_node, bool *sync)
+static void
+get_atomic_access (Node_Id gnat_node, atomic_acces_t *type, bool *sync)
 {
-  const Node_Id gnat_parent = Parent (gnat_node);
+  Node_Id gnat_parent, gnat_temp;
   unsigned char attr_id;
-  bool as_a_whole = true;
 
-  /* First, scan the parent to find out cases where the flag is irrelevant.  */
+  /* First, scan the parent to filter out irrelevant cases.  */
+  gnat_parent = Parent (gnat_node);
   switch (Nkind (gnat_parent))
     {
     case N_Attribute_Reference:
       attr_id = Get_Attribute_Id (Attribute_Name (gnat_parent));
       /* Do not mess up machine code insertions.  */
       if (attr_id == Attr_Asm_Input || attr_id == Attr_Asm_Output)
-	return false;
+	goto not_atomic;
 
       /* Nothing to do if we are the prefix of an attribute, since we do not
 	 want an atomic access for things like 'Size.  */
@@ -4940,45 +4913,86 @@  atomic_access_required_p (Node_Id gnat_node, bool *sync)
     case N_Reference:
       /* The N_Reference node is like an attribute.  */
       if (Prefix (gnat_parent) == gnat_node)
-	return false;
-      break;
-
-    case N_Indexed_Component:
-    case N_Selected_Component:
-    case N_Slice:
-      /* If we are the prefix, then the access is only partial.  */
-      if (Prefix (gnat_parent) == gnat_node)
-	as_a_whole = false;
+	goto not_atomic;
       break;
 
     case N_Object_Renaming_Declaration:
       /* Nothing to do for the identifier in an object renaming declaration,
          the renaming itself does not need atomic access.  */
-      return false;
+      goto not_atomic;
 
     default:
       break;
     }
 
-  /* Then, scan the node to find the atomic object.  */
-  gnat_node = gnat_strip_type_conversion (gnat_node);
+  /* Now strip any type conversion from GNAT_NODE.  */
+  if (Nkind (gnat_node) == N_Type_Conversion
+      || Nkind (gnat_node) == N_Unchecked_Type_Conversion)
+    gnat_node = Expression (gnat_node);
 
-  /* For Atomic itself, only reads and updates of the object as a whole require
-     atomic access (RM C.6 (15)).  But for Volatile_Full_Access, all reads and
-     updates require atomic access.  */
-  if (!(as_a_whole && node_is_atomic (gnat_node))
-      && !node_has_volatile_full_access (gnat_node))
-    return false;
+  /* Up to Ada 2012, for Atomic itself, only reads and updates of the object as
+     a whole require atomic access (RM C.6(15)).  But, starting with Ada 2020,
+     reads of or writes to a nonatomic subcomponent of the object also require
+     atomic access (RM C.6(19)).  */
+  if (node_is_atomic (gnat_node))
+    {
+      bool as_a_whole = true;
 
-  /* If an outer atomic access will also be required, it cancels this one.  */
-  if (outer_atomic_access_required_p (gnat_node))
-    return false;
+      /* If we are the prefix of the parent, then the access is partial.  */
+      for (gnat_temp = gnat_node, gnat_parent = Parent (gnat_temp);
+	   node_is_component (gnat_parent) && Prefix (gnat_parent) == gnat_temp;
+	   gnat_temp = gnat_parent, gnat_parent = Parent (gnat_temp))
+	if (Ada_Version < Ada_2020 || node_is_atomic (gnat_parent))
+	  goto not_atomic;
+	else
+	  as_a_whole = false;
 
-  *sync = Atomic_Sync_Required (gnat_node);
+      /* We consider that partial accesses are not sequential actions and,
+	 therefore, do not require synchronization.  */
+      *type = SIMPLE_ATOMIC;
+      *sync = as_a_whole ? Atomic_Sync_Required (gnat_node) : false;
+      return;
+    }
 
-  return true;
+  /* Look for an outer atomic access of a nonatomic subcomponent.  Note that,
+     for VFA, we do this before looking at the node itself because we need to
+     access the outermost VFA object atomically, unlike for Atomic where it is
+     the innermost atomic object (RM C.6(19)).  */
+  for (gnat_temp = gnat_node;
+       node_is_component (gnat_temp);
+       gnat_temp = Prefix (gnat_temp))
+    if ((Ada_Version >= Ada_2020 && node_is_atomic (Prefix (gnat_temp)))
+	|| node_is_volatile_full_access (Prefix (gnat_temp)))
+      {
+	*type = OUTER_ATOMIC;
+	*sync = false;
+	return;
+      }
+
+  /* Unlike Atomic, accessing a VFA object always requires atomic access.  */
+  if (node_is_volatile_full_access (gnat_node))
+    {
+      *type = SIMPLE_ATOMIC;
+      *sync = false;
+      return;
+    }
+
+not_atomic:
+  *type = NOT_ATOMIC;
+  *sync = false;
 }
 
+/* Return true if GNAT_NODE requires simple atomic access and, if so, set SYNC
+   according to the associated synchronization setting.  */
+
+static inline bool
+simple_atomic_access_required_p (Node_Id gnat_node, bool *sync)
+{
+  atomic_acces_t type;
+  get_atomic_access (gnat_node, &type, sync);
+  return type == SIMPLE_ATOMIC;
+}
+
 /* Create a temporary variable with PREFIX and TYPE, and return it.  */
 
 static tree
@@ -5013,14 +5027,13 @@  create_init_temporary (const char *prefix, tree gnu_init, tree *gnu_init_stmt,
    GNU_RESULT_TYPE_P is a pointer to where we should place the result type.
    If GNU_TARGET is non-null, this must be a function call on the RHS of a
    N_Assignment_Statement and the result is to be placed into that object.
-   If OUTER_ATOMIC_ACCESS is true, then the assignment to GNU_TARGET must be a
-   load-modify-store sequence.  Otherwise, if ATOMIC_ACCESS is true, then the
-   assignment to GNU_TARGET must be atomic.  If, in addition, ATOMIC_SYNC is
-   true, then the assignment to GNU_TARGET requires atomic synchronization.  */
+   ATOMIC_ACCESS is the type of atomic access to be used for the assignment
+   to GNU_TARGET.  If, in addition, ATOMIC_SYNC is true, then the assignment
+   to GNU_TARGET requires atomic synchronization.  */
 
 static tree
 Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
-	     bool outer_atomic_access, bool atomic_access, bool atomic_sync)
+	     atomic_acces_t atomic_access, bool atomic_sync)
 {
   const bool function_call = (Nkind (gnat_node) == N_Function_Call);
   const bool returning_value = (function_call && !gnu_target);
@@ -5047,7 +5060,8 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
   bool pushed_binding_level = false;
   Entity_Id gnat_formal;
   Node_Id gnat_actual;
-  bool sync;
+  atomic_acces_t aa_type;
+  bool aa_sync;
 
   gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type));
 
@@ -5346,8 +5360,8 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
       if (is_true_formal_parm
 	  && !is_by_ref_formal_parm
 	  && Ekind (gnat_formal) != E_Out_Parameter
-	  && atomic_access_required_p (gnat_actual, &sync))
-	gnu_actual = build_atomic_load (gnu_actual, sync);
+	  && simple_atomic_access_required_p (gnat_actual, &aa_sync))
+	gnu_actual = build_atomic_load (gnu_actual, aa_sync);
 
       /* If this was a procedure call, we may not have removed any padding.
 	 So do it here for the part we will use as an input, if any.  */
@@ -5647,16 +5661,19 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 		  gnu_result = convert (TREE_TYPE (gnu_actual), gnu_result);
 	      }
 
+	    get_atomic_access (gnat_actual, &aa_type, &aa_sync);
+
 	    /* If an outer atomic access is required for an actual parameter,
 	       build the load-modify-store sequence.  */
-	    if (outer_atomic_access_required_p (gnat_actual))
+	    if (aa_type == OUTER_ATOMIC)
 	      gnu_result
 		= build_load_modify_store (gnu_actual, gnu_result, gnat_node);
 
-	    /* Or else, if simple atomic access is required, build the atomic
+	    /* Or else, if a simple atomic access is required, build the atomic
 	       store.  */
-	    else if (atomic_access_required_p (gnat_actual, &sync))
-	      gnu_result = build_atomic_store (gnu_actual, gnu_result, sync);
+	    else if (aa_type == SIMPLE_ATOMIC)
+	      gnu_result
+		= build_atomic_store (gnu_actual, gnu_result, aa_sync);
 
 	    /* Otherwise build a regular assignment.  */
 	    else
@@ -5708,10 +5725,10 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 	    op_code = MODIFY_EXPR;
 
 	  /* Use the required method to move the result to the target.  */
-	  if (outer_atomic_access)
+	  if (atomic_access == OUTER_ATOMIC)
 	    gnu_call
 	      = build_load_modify_store (gnu_target, gnu_call, gnat_node);
-	  else if (atomic_access)
+	  else if (atomic_access == SIMPLE_ATOMIC)
 	    gnu_call = build_atomic_store (gnu_target, gnu_call, atomic_sync);
 	  else
 	    gnu_call
@@ -6631,8 +6648,8 @@  common:
 static bool
 lhs_or_actual_p (Node_Id gnat_node)
 {
-  Node_Id gnat_parent = Parent (gnat_node);
-  Node_Kind kind = Nkind (gnat_parent);
+  const Node_Id gnat_parent = Parent (gnat_node);
+  const Node_Kind kind = Nkind (gnat_parent);
 
   if (kind == N_Assignment_Statement && Name (gnat_parent) == gnat_node)
     return true;
@@ -6653,12 +6670,10 @@  lhs_or_actual_p (Node_Id gnat_node)
 static bool
 present_in_lhs_or_actual_p (Node_Id gnat_node)
 {
-  Node_Kind kind;
-
   if (lhs_or_actual_p (gnat_node))
     return true;
 
-  kind = Nkind (Parent (gnat_node));
+  const Node_Kind kind = Nkind (Parent (gnat_node));
 
   if ((kind == N_Type_Conversion || kind == N_Unchecked_Type_Conversion)
       && lhs_or_actual_p (Parent (gnat_node)))
@@ -6747,7 +6762,8 @@  gnat_to_gnu (Node_Id gnat_node)
   tree gnu_result_type = void_type_node;
   tree gnu_expr, gnu_lhs, gnu_rhs;
   Node_Id gnat_temp;
-  bool sync = false;
+  atomic_acces_t aa_type;
+  bool aa_sync;
 
   /* Save node number for error message and set location information.  */
   Current_Error_Node = gnat_node;
@@ -6819,9 +6835,9 @@  gnat_to_gnu (Node_Id gnat_node)
       gnu_result = Identifier_to_gnu (gnat_node, &gnu_result_type);
 
       /* If atomic access is required on the RHS, build the atomic load.  */
-      if (atomic_access_required_p (gnat_node, &sync)
+      if (simple_atomic_access_required_p (gnat_node, &aa_sync)
 	  && !present_in_lhs_or_actual_p (gnat_node))
-	gnu_result = build_atomic_load (gnu_result, sync);
+	gnu_result = build_atomic_load (gnu_result, aa_sync);
       break;
 
     case N_Integer_Literal:
@@ -7153,9 +7169,9 @@  gnat_to_gnu (Node_Id gnat_node)
       gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
 
       /* If atomic access is required on the RHS, build the atomic load.  */
-      if (atomic_access_required_p (gnat_node, &sync)
+      if (simple_atomic_access_required_p (gnat_node, &aa_sync)
 	  && !present_in_lhs_or_actual_p (gnat_node))
-	gnu_result = build_atomic_load (gnu_result, sync);
+	gnu_result = build_atomic_load (gnu_result, aa_sync);
       break;
 
     case N_Indexed_Component:
@@ -7230,9 +7246,9 @@  gnat_to_gnu (Node_Id gnat_node)
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
 	/* If atomic access is required on the RHS, build the atomic load.  */
-	if (atomic_access_required_p (gnat_node, &sync)
+	if (simple_atomic_access_required_p (gnat_node, &aa_sync)
 	    && !present_in_lhs_or_actual_p (gnat_node))
-	  gnu_result = build_atomic_load (gnu_result, sync);
+	  gnu_result = build_atomic_load (gnu_result, aa_sync);
       }
       break;
 
@@ -7308,9 +7324,9 @@  gnat_to_gnu (Node_Id gnat_node)
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
 	/* If atomic access is required on the RHS, build the atomic load.  */
-	if (atomic_access_required_p (gnat_node, &sync)
+	if (simple_atomic_access_required_p (gnat_node, &aa_sync)
 	    && !present_in_lhs_or_actual_p (gnat_node))
-	  gnu_result = build_atomic_load (gnu_result, sync);
+	  gnu_result = build_atomic_load (gnu_result, aa_sync);
       }
       break;
 
@@ -7811,14 +7827,10 @@  gnat_to_gnu (Node_Id gnat_node)
 				       N_Raise_Storage_Error);
       else if (Nkind (Expression (gnat_node)) == N_Function_Call)
 	{
-	  bool outer_atomic_access
-	    = outer_atomic_access_required_p (Name (gnat_node));
-	  bool atomic_access
-	    = !outer_atomic_access
-	      && atomic_access_required_p (Name (gnat_node), &sync);
+	  get_atomic_access (Name (gnat_node), &aa_type, &aa_sync);
 	  gnu_result
 	    = Call_to_gnu (Expression (gnat_node), &gnu_result_type, gnu_lhs,
-			   outer_atomic_access, atomic_access, sync);
+			   aa_type, aa_sync);
 	}
       else
 	{
@@ -7848,14 +7860,17 @@  gnat_to_gnu (Node_Id gnat_node)
 
 	  gigi_checking_assert (!Do_Range_Check (gnat_expr));
 
+	  get_atomic_access (Name (gnat_node), &aa_type, &aa_sync);
+
 	  /* If an outer atomic access is required on the LHS, build the load-
 	     modify-store sequence.  */
-	  if (outer_atomic_access_required_p (Name (gnat_node)))
+	  if (aa_type == OUTER_ATOMIC)
 	    gnu_result = build_load_modify_store (gnu_lhs, gnu_rhs, gnat_node);
 
-	  /* Or else, if atomic access is required, build the atomic store.  */
-	  else if (atomic_access_required_p (Name (gnat_node), &sync))
-	    gnu_result = build_atomic_store (gnu_lhs, gnu_rhs, sync);
+	  /* Or else, if a simple atomic access is required, build the atomic
+	     store.  */
+	  else if (aa_type == SIMPLE_ATOMIC)
+	    gnu_result = build_atomic_store (gnu_lhs, gnu_rhs, aa_sync);
 
 	  /* Or else, use memset when the conditions are met.  This has already
 	     been validated by Aggr_Assignment_OK_For_Backend in the front-end
@@ -8176,7 +8191,7 @@  gnat_to_gnu (Node_Id gnat_node)
     case N_Function_Call:
     case N_Procedure_Call_Statement:
       gnu_result = Call_to_gnu (gnat_node, &gnu_result_type, NULL_TREE,
-				false, false, false);
+				NOT_ATOMIC, false);
       break;
 
     /************************/
@@ -8476,7 +8491,7 @@  gnat_to_gnu (Node_Id gnat_node)
 		  /* If the operand is going to end up in memory,
 		     mark it addressable.  Note that we don't test
 		     allows_mem like in the input case below; this
-		     is modelled on the C front-end.  */
+		     is modeled on the C front-end.  */
 		  if (!allows_reg)
 		    {
 		      output = remove_conversions (output, false);
@@ -11123,7 +11138,7 @@  get_elaboration_procedure (void)
 static Entity_Id
 get_controlling_type (Entity_Id subprog)
 {
-  /* This is modelled on Expand_Interface_Thunk.  */
+  /* This is modeled on Expand_Interface_Thunk.  */
   Entity_Id controlling_type = Etype (First_Formal (subprog));
   if (Is_Access_Type (controlling_type))
     controlling_type = Directly_Designated_Type (controlling_type);

--- gcc/ada/sem_prag.adb
+++ gcc/ada/sem_prag.adb
@@ -14039,7 +14039,6 @@  package body Sem_Prag is
             D    : Node_Id;
             E    : Entity_Id;
             E_Id : Node_Id;
-            K    : Node_Kind;
 
          begin
             Check_Ada_83_Warning;
@@ -14068,18 +14067,19 @@  package body Sem_Prag is
             end if;
 
             D := Declaration_Node (E);
-            K := Nkind (D);
 
-            if (K = N_Full_Type_Declaration and then Is_Array_Type (E))
+            if (Nkind (D) = N_Full_Type_Declaration and then Is_Array_Type (E))
               or else
-                ((Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
-                   and then Nkind (D) = N_Object_Declaration
+                (Nkind (D) = N_Object_Declaration
+                   and then (Ekind (E) = E_Constant
+                              or else
+                             Ekind (E) = E_Variable)
                    and then Nkind (Object_Definition (D)) =
                                        N_Constrained_Array_Definition)
             then
-               --  The flag is set on the object, or on the base type
+               --  The flag is set on the base type, or on the object
 
-               if Nkind (D) /= N_Object_Declaration then
+               if Nkind (D) = N_Full_Type_Declaration then
                   E := Base_Type (E);
                end if;
 
@@ -14087,7 +14087,8 @@  package body Sem_Prag is
 
                if Prag_Id = Pragma_Atomic_Components then
                   if Ada_Version >= Ada_2020 then
-                     Check_Atomic_VFA (Component_Type (E), VFA => False);
+                     Check_Atomic_VFA
+                       (Component_Type (Etype (E)), VFA => False);
                   end if;
                   Set_Has_Atomic_Components (E);
                   Set_Has_Independent_Components (E);
@@ -17963,7 +17964,6 @@  package body Sem_Prag is
             D    : Node_Id;
             E_Id : Node_Id;
             E    : Entity_Id;
-            K    : Node_Kind;
 
          begin
             Check_Ada_83_Warning;
@@ -18030,11 +18030,10 @@  package body Sem_Prag is
             end if;
 
             D := Declaration_Node (E);
-            K := Nkind (D);
 
             --  The flag is set on the base type, or on the object
 
-            if K = N_Full_Type_Declaration
+            if Nkind (D) = N_Full_Type_Declaration
               and then (Is_Array_Type (E) or else Is_Record_Type (E))
             then
                Set_Has_Independent_Components (Base_Type (E));

--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -17890,11 +17890,22 @@  package body Sem_Util is
 
    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;
+
+         --  If the prefix is an access value, only the designated type matters
+
+         if Is_Access_Type (Etype (R)) then
+            if Is_Atomic (Designated_Type (Etype (R))) then
+               return True;
+            end if;
+
+         else
+            if Is_Atomic (Etype (R)) or else Is_Atomic_Object (R) then
+               return True;
+            end if;
          end if;
       end loop;