ada: Fix internal error with Atomic Volatile_Full_Access object

The initial implementation of the GNAT aspect/pragma Volatile_Full_Access
made it incompatible with Atomic, because it was not decided whether the
read-modify-write sequences generated by Volatile_Full_Access would need
to be implemented atomically when Atomic was also specified, which would
have required a compare-and-swap primitive from the target architecture.

But Ada 2022 introduced Full_Access_Only and retrofitted it into Atomic
in the process, answering the above question by the negative, so the
incompatibility between Volatile_Full_Access and Atomic was lifted in
Ada 2012 as well, unfortunately without adjusting the implementation.

gcc/ada/

	* gcc-interface/trans.cc (get_atomic_access): Deal specifically with
	nodes that are both Atomic and Volatile_Full_Access in Ada 2012.

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 7cced04361d0893c884732768b35a7d9a4710d57..caa0f56a34d9e46a106662db4778b7ba925fac5d 100644 (file)
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -4387,9 +4387,9 @@ get_atomic_access (Node_Id gnat_node, atomic_acces_t *type, bool *sync)
     gnat_node = Expression (gnat_node);
 
   /* 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 2022,
-     reads of or writes to a nonatomic subcomponent of the object also require
-     atomic access (RM C.6(19)).  */
+     a whole require atomic access (RM C.6(15)), unless the object is also VFA.
+     But, starting with Ada 2022, reads of or writes to nonatomic subcomponents
+     of the object also require atomic access (RM C.6(19)).  */
   if (node_is_atomic (gnat_node))
     {
       bool as_a_whole = true;
@@ -4398,7 +4398,9 @@ get_atomic_access (Node_Id gnat_node, atomic_acces_t *type, bool *sync)
       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_2022 || node_is_atomic (gnat_parent))
+       if (Ada_Version < Ada_2022
+           ? !node_is_volatile_full_access (gnat_node)
+           : node_is_atomic (gnat_parent))
          goto not_atomic;
        else
          as_a_whole = false;