[Ada] Pragma Atomic wrongly rejected on composite component

[Ada] Pragma Atomic wrongly rejected on composite component

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 659 bytes --]

The compiler wrongly rejects a pragma Atomic on a component of a record whose 
type is composite, but it accepts the pragma on a variable of the same type.

Tested on x86_64-suse-linux, applied on the mainline and 7 branch.


2017-09-09  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (promote_object_alignment): New function taken
	from...
	(gnat_to_gnu_entity) <E_Variable>: ...here.  Invoke it.
	(gnat_to_gnu_field): If the field is Atomic or VFA, invoke it and
	create a padding type on success before doing the atomic check.


2017-09-09  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/atomic3.ads: New test.

-- 
Eric Botcazou

[-- Attachment #2: atomic3.ads --]
[-- Type: text/x-adasrc, Size: 773 bytes --]

-- { dg-do compile }

package Atomic3 is

   type Four_Bits is mod 2**4;
   type Fourteen_Bits is mod 2**14;
   type Twenty_Eight_Bits is mod 2**28;

   type Rec1 (Mode : Boolean := True) is record
      Reserved : Four_Bits;
      case Mode is
         when True =>
           High_Part : Fourteen_Bits;
           Low_Part  : Fourteen_Bits;
         when False =>
           Data : Twenty_Eight_Bits;
      end case;
   end record;
   for Rec1 use record
      Reserved  at 0 range 28 .. 31;
      High_Part at 0 range 14 .. 27;
      Low_Part  at 0 range  0 .. 13;
      Data      at 0 range  0 .. 27;
   end record;
   for Rec1'Size use 32;
   pragma Unchecked_Union (Rec1);

   type Rec2 is record
      A : Rec1;
      pragma Atomic (A);
   end record;

end Atomic3;

[-- Attachment #3: p.diff --]
[-- Type: text/x-patch, Size: 4874 bytes --]

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 251929)
+++ gcc-interface/decl.c	(working copy)
@@ -230,6 +230,7 @@ static vec<variant_desc> build_variant_l
 static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
 static void set_rm_size (Uint, tree, Entity_Id);
 static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
+static unsigned int promote_object_alignment (tree, Entity_Id);
 static void check_ok_for_atomic_type (tree, Entity_Id, bool);
 static tree create_field_decl_from (tree, tree, tree, tree, tree,
 				    vec<subst_pair>);
@@ -856,45 +857,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		    && No (Renamed_Object (gnat_entity))
 		    && No (Address_Clause (gnat_entity))))
 	    && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)
-	  {
-	    unsigned int size_cap, align_cap;
-
-	    /* No point in promoting the alignment if this doesn't prevent
-	       BLKmode access to the object, in particular block copy, as
-	       this will for example disable the NRV optimization for it.
-	       No point in jumping through all the hoops needed in order
-	       to support BIGGEST_ALIGNMENT if we don't really have to.
-	       So we cap to the smallest alignment that corresponds to
-	       a known efficient memory access pattern of the target.  */
-	    if (Is_Atomic_Or_VFA (gnat_entity))
-	      {
-		size_cap = UINT_MAX;
-		align_cap = BIGGEST_ALIGNMENT;
-	      }
-	    else
-	      {
-		size_cap = MAX_FIXED_MODE_SIZE;
-		align_cap = get_mode_alignment (ptr_mode);
-	      }
-
-	    if (!tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
-		|| compare_tree_int (TYPE_SIZE (gnu_type), size_cap) > 0)
-	      align = 0;
-	    else if (compare_tree_int (TYPE_SIZE (gnu_type), align_cap) > 0)
-	      align = align_cap;
-	    else
-	      align = ceil_pow2 (tree_to_uhwi (TYPE_SIZE (gnu_type)));
-
-	    /* But make sure not to under-align the object.  */
-	    if (align <= TYPE_ALIGN (gnu_type))
-	      align = 0;
-
-	    /* And honor the minimum valid atomic alignment, if any.  */
-#ifdef MINIMUM_ATOMIC_ALIGNMENT
-	    else if (align < MINIMUM_ATOMIC_ALIGNMENT)
-	      align = MINIMUM_ATOMIC_ALIGNMENT;
-#endif
-	  }
+	  align = promote_object_alignment (gnu_type, gnat_entity);
 
 	/* If the object is set to have atomic components, find the component
 	   type and validate it.
@@ -6891,7 +6854,15 @@ gnat_to_gnu_field (Entity_Id gnat_field,
     }
 
   if (Is_Atomic_Or_VFA (gnat_field))
-    check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
+    {
+      const unsigned int align
+	= promote_object_alignment (gnu_field_type, gnat_field);
+      if (align > 0)
+	gnu_field_type
+	  = maybe_pad_type (gnu_field_type, NULL_TREE, align, gnat_field,
+			    false, false, definition, true);
+      check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
+    }
 
   if (Present (Component_Clause (gnat_field)))
     {
@@ -8807,6 +8778,53 @@ validate_alignment (Uint alignment, Enti
 
   return align;
 }
+\f
+/* Promote the alignment of GNU_TYPE corresponding to GNAT_ENTITY.  Return
+   a positive value on success or zero on failure.  */
+
+static unsigned int
+promote_object_alignment (tree gnu_type, Entity_Id gnat_entity)
+{
+  unsigned int align, size_cap, align_cap;
+
+  /* No point in promoting the alignment if this doesn't prevent BLKmode access
+     to the object, in particular block copy, as this will for example disable
+     the NRV optimization for it.  No point in jumping through all the hoops
+     needed in order to support BIGGEST_ALIGNMENT if we don't really have to.
+     So we cap to the smallest alignment that corresponds to a known efficient
+     memory access pattern, except for Atomic and Volatile_Full_Access.  */
+  if (Is_Atomic_Or_VFA (gnat_entity))
+    {
+      size_cap = UINT_MAX;
+      align_cap = BIGGEST_ALIGNMENT;
+    }
+  else
+    {
+      size_cap = MAX_FIXED_MODE_SIZE;
+      align_cap = get_mode_alignment (ptr_mode);
+    }
+
+  /* Do the promotion within the above limits.  */
+  if (!tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
+      || compare_tree_int (TYPE_SIZE (gnu_type), size_cap) > 0)
+    align = 0;
+  else if (compare_tree_int (TYPE_SIZE (gnu_type), align_cap) > 0)
+    align = align_cap;
+  else
+    align = ceil_pow2 (tree_to_uhwi (TYPE_SIZE (gnu_type)));
+
+  /* But make sure not to under-align the object.  */
+  if (align <= TYPE_ALIGN (gnu_type))
+    align = 0;
+
+   /* And honor the minimum valid atomic alignment, if any.  */
+#ifdef MINIMUM_ATOMIC_ALIGNMENT
+  else if (align < MINIMUM_ATOMIC_ALIGNMENT)
+    align = MINIMUM_ATOMIC_ALIGNMENT;
+#endif
+
+  return align;
+}
 \f
 /* Verify that TYPE is something we can implement atomically.  If not, issue
    an error for GNAT_ENTITY.  COMPONENT_P is true if we are being called to

Re: [Ada] Pragma Atomic wrongly rejected on composite component

[Andreas Schwab]

On Sep 09 2017, Eric Botcazou <ebotcazou@adacore.com> wrote:

> 	* gcc-interface/decl.c (promote_object_alignment): New function taken
> 	from...
> 	(gnat_to_gnu_entity) <E_Variable>: ...here.  Invoke it.
> 	(gnat_to_gnu_field): If the field is Atomic or VFA, invoke it and
> 	create a padding type on success before doing the atomic check.

That regresses on gnat.dg/specs/atomic1.ads for aarch64/-mabi=ilp32,
missing the error on line 13.  The missing error on line 9 is
preexisting.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

Re: [Ada] Pragma Atomic wrongly rejected on composite component

[Eric Botcazou]

> That regresses on gnat.dg/specs/atomic1.ads for aarch64/-mabi=ilp32,
> missing the error on line 13.  The missing error on line 9 is
> preexisting.

That's sort of expected, since the point of the patch is to make the 2 
situations equivalent wrt atomicity.  Clearly the test is not portable and 
will fail on targets for which pointer size and word size are not equal.

-- 
Eric Botcazou