decl.c (gnat_to_gnu_field): Rework error messages for fields requiring strict alignme...
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 29 Jun 2019 07:53:27 +0000 (07:53 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 29 Jun 2019 07:53:27 +0000 (07:53 +0000)
* 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.

From-SVN: r272819

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/atomic2.ads
gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads
gcc/testsuite/gnat.dg/specs/size_clause3.ads

index 3abcabb..31805e5 100644 (file)
@@ -1,5 +1,11 @@
 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>
+
        * gcc-interface/trans.c (mark_visited_r): Set TYPE_SIZES_GIMPLIFIED on
        the main variant of a type, if any.
 
index e38986b..6d7900d 100644 (file)
@@ -7026,7 +7026,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
          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, tree gnu_record_type, int packed,
          && !(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 7766716..679f1da 100644 (file)
@@ -1,5 +1,11 @@
 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.
+
+2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gnat.dg/array35.adb: New test.
        * gnat.dg/array36.adb: Likewise.
 
index b332884..17b9f83 100644 (file)
@@ -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 f4c0b98..0dcffbc 100644 (file)
@@ -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 b7602d9..fd7999a 100644 (file)
@@ -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;