[Ada] Improved error message for misaligned fields

Message ID 2776998.FaM2xUUPn7@polaris
State New
Headers show
Series
  • [Ada] Improved error message for misaligned fields
Related show

Commit Message

Eric Botcazou June 29, 2019, 7:53 a.m.
The error message now mentions the alignment of the field's type and gives the 
position in storage units (bytes in Ada parlance) for the sake of consistency.

Tested on x86-64/Linux, applied on mainline.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_field): Rework error messages for
	fields requiring strict alignment, add explicit test on Storage_Unit
	for position and size, and mention type alignment for position.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/atomic2.ads: Adjust error message.
	* gnat.dg/specs/clause_on_volatile.ads: Likewise.
	* gnat.dg/specs/size_clause3.ads: Likewise.

-- 
Eric Botcazou

Patch

Index: ada/gcc-interface/decl.c
===================================================================
--- ada/gcc-interface/decl.c	(revision 272811)
+++ ada/gcc-interface/decl.c	(working copy)
@@ -7026,7 +7026,7 @@  gnat_to_gnu_field (Entity_Id gnat_field,
 	  if (TREE_CODE (TYPE_SIZE (gnu_parent)) == INTEGER_CST
 	      && tree_int_cst_lt (gnu_pos, TYPE_SIZE (gnu_parent)))
 	    post_error_ne_tree
-	      ("offset of& must be beyond parent{, minimum allowed is ^}",
+	      ("position for& must be beyond parent{, minimum allowed is ^}",
 	       Position (gnat_clause), gnat_field, TYPE_SIZE_UNIT (gnu_parent));
 	}
 
@@ -7040,79 +7040,82 @@  gnat_to_gnu_field (Entity_Id gnat_field,
 	  && !(type_annotate_only && Is_Tagged_Type (gnat_field_type)))
 	{
 	  const unsigned int type_align = TYPE_ALIGN (gnu_field_type);
+	  const char *field_s;
 
 	  if (TYPE_ALIGN (gnu_record_type)
 	      && TYPE_ALIGN (gnu_record_type) < type_align)
 	    SET_TYPE_ALIGN (gnu_record_type, type_align);
 
-	  /* If the position is not a multiple of the alignment of the type,
-	     then error out and reset the position.  */
+	  if (is_atomic)
+	    field_s = "atomic &";
+	  else if (is_aliased)
+	    field_s = "aliased &";
+	  else if (is_independent)
+	    field_s = "independent &";
+	  else if (is_strict_alignment)
+	    field_s = "& with aliased or tagged part";
+	  else
+	    gcc_unreachable ();
+
+	  /* If the position is not a multiple of the storage unit, then error
+	     out and reset the position.  */
 	  if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
-					  bitsize_int (type_align))))
+					  bitsize_unit_node)))
 	    {
-	      const char *s;
-
-	      if (is_atomic)
-		s = "position of atomic field& must be multiple of ^ bits";
-	      else if (is_aliased)
-		s = "position of aliased field& must be multiple of ^ bits";
-	      else if (is_independent)
-		s = "position of independent field& must be multiple of ^ bits";
-	      else if (is_strict_alignment)
-		s = "position of & with aliased or tagged part must be"
-		    " multiple of ^ bits";
-	      else
-		gcc_unreachable ();
+	      char s[128];
+	      snprintf (s, sizeof (s), "position for %s must be "
+			"multiple of Storage_Unit", field_s);
+	      post_error_ne (s, First_Bit (gnat_clause), gnat_field);
+	      gnu_pos = NULL_TREE;
+	    }
 
+	  /* If the position is not a multiple of the alignment of the type,
+	     then error out and reset the position.  */
+	  else if (type_align > BITS_PER_UNIT
+		   && !integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
+						  bitsize_int (type_align))))
+	    {
+	      char s[128];
+              snprintf (s, sizeof (s), "position for %s must be multiple of ^",
+			field_s);
 	      post_error_ne_num (s, First_Bit (gnat_clause), gnat_field,
-				 type_align);
+				 type_align / BITS_PER_UNIT);
+	      post_error_ne_num ("\\because alignment of its type& is ^",
+				 First_Bit (gnat_clause), Etype (gnat_field),
+				 type_align / BITS_PER_UNIT);
 	      gnu_pos = NULL_TREE;
 	    }
 
 	  if (gnu_size)
 	    {
-	      tree gnu_type_size = TYPE_SIZE (gnu_field_type);
-	      const int cmp = tree_int_cst_compare (gnu_size, gnu_type_size);
+	      tree type_size = TYPE_SIZE (gnu_field_type);
+	      int cmp;
 
-	      /* If the size is lower than that of the type, or greater for
-		 atomic and aliased, then error out and reset the size.  */
-	      if (cmp < 0 || (cmp > 0 && (is_atomic || is_aliased)))
+	      /* If the size is not a multiple of the storage unit, then error
+		 out and reset the size.  */
+	      if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_size,
+					      bitsize_unit_node)))
 		{
-		  const char *s;
-
-		  if (is_atomic)
-		    s = "size of atomic field& must be ^ bits";
-		  else if (is_aliased)
-		    s = "size of aliased field& must be ^ bits";
-		  else if (is_independent)
-		    s = "size of independent field& must be at least ^ bits";
-		  else if (is_strict_alignment)
-		    s = "size of & with aliased or tagged part must be"
-			" at least ^ bits";
-		  else
-		    gcc_unreachable ();
-
-		  post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field,
-				      gnu_type_size);
+		  char s[128];
+		  snprintf (s, sizeof (s), "size for %s must be "
+			    "multiple of Storage_Unit", field_s);
+		  post_error_ne (s, Last_Bit (gnat_clause), gnat_field);
 		  gnu_size = NULL_TREE;
 		}
 
-	      /* Likewise if the size is not a multiple of a byte,  */
-	      else if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_size,
-						   bitsize_unit_node)))
+	      /* If the size is lower than that of the type, or greater for
+		 atomic and aliased, then error out and reset the size.  */
+	      else if ((cmp = tree_int_cst_compare (gnu_size, type_size)) < 0
+		       || (cmp > 0 && (is_atomic || is_aliased)))
 		{
-		  const char *s;
-
-		  if (is_independent)
-		    s = "size of independent field& must be multiple of"
-			" Storage_Unit";
-		  else if (is_strict_alignment)
-		    s = "size of & with aliased or tagged part must be"
-			" multiple of Storage_Unit";
+		  char s[128];
+		  if (is_atomic || is_aliased)
+		    snprintf (s, sizeof (s), "size for %s must be ^", field_s);
 		  else
-		    gcc_unreachable ();
-
-		  post_error_ne (s, Last_Bit (gnat_clause), gnat_field);
+  		    snprintf (s, sizeof (s), "size for %s must be at least ^",
+			      field_s);
+		  post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field,
+				      type_size);
 		  gnu_size = NULL_TREE;
 		}
 	    }
Index: testsuite/gnat.dg/specs/atomic2.ads
===================================================================
--- testsuite/gnat.dg/specs/atomic2.ads	(revision 272633)
+++ testsuite/gnat.dg/specs/atomic2.ads	(working copy)
@@ -9,7 +9,7 @@  package Atomic2 is
   end record;
   for Rec1 use record
     C at 0 range 0 .. 7;
-    I at 1 range 0 .. 31; -- { dg-error "position of atomic field" }
+    I at 1 range 0 .. 31; -- { dg-error "position for atomic|alignment" }
   end record;
 
   type Rec2 is record
Index: testsuite/gnat.dg/specs/clause_on_volatile.ads
===================================================================
--- testsuite/gnat.dg/specs/clause_on_volatile.ads	(revision 272633)
+++ testsuite/gnat.dg/specs/clause_on_volatile.ads	(working copy)
@@ -39,7 +39,7 @@  package Clause_On_Volatile is
   For A2'Alignment use 4;
   for A2 use record
      B at 0 range 0 .. 7;
-     AW at 1 range 0 .. 31; -- { dg-error "must be multiple" }
+     AW at 1 range 0 .. 31; -- { dg-error "must be multiple|alignment" }
   end record;
 
   type A3 is record
@@ -49,7 +49,7 @@  package Clause_On_Volatile is
   For A3'Alignment use 4;
   for A3 use record
      B at 0 range 0 .. 7;
-     AW at 1 range 0 .. 15; -- { dg-error "must be (multiple||\[0-9\]*)" }
+     AW at 1 range 0 .. 15; -- { dg-error "must be (multiple||\[0-9\]*)|alignment" }
   end record;
 
   type V1 is record
Index: testsuite/gnat.dg/specs/size_clause3.ads
===================================================================
--- testsuite/gnat.dg/specs/size_clause3.ads	(revision 272633)
+++ testsuite/gnat.dg/specs/size_clause3.ads	(working copy)
@@ -14,7 +14,7 @@  package Size_Clause3 is
     rr : R1; -- size must be 40
   end record;
   for S1 use record
-    rr at 0 range 0 .. 39;  -- { dg-error "size of .rr. with aliased or tagged" }
+    rr at 0 range 0 .. 39;  -- { dg-error "size for .rr. with aliased or tagged" }
   end record;
 
   -- The record is explicitly given alignment 1 so its real type is 40.
@@ -44,7 +44,7 @@  package Size_Clause3 is
     rr : R3; -- size must be 40
   end record;
   for S3 use record
-    rr at 0 range 0 .. 39;  -- { dg-error "size of .rr. with aliased or tagged" }
+    rr at 0 range 0 .. 39;  -- { dg-error "size for .rr. with aliased or tagged" }
   end record;
 
 end Size_Clause3;