decl.c (gnat_to_gnu_field): Post the error message for parent overlapping on the...

	* gcc-interface/decl.c (gnat_to_gnu_field): Post the error message
	for parent overlapping on the position instead of on the first bit.
	For a field that needs strict alignment, issue the error for the
	position first and, for the size, issue an error if it is too large
	only for the atomic and aliased cases.  Issue a specific error if
	the size is not a multiple of a byte in the volatile and the stric
	alignment cases.

From-SVN: r219009

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d3ffcfd002fe852f8cf8899d2e798f17db9e469c..c6364eb22d15b13ed89766646882d3f52be13c15 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2014-12-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_field): Post the error message
+       for parent overlapping on the position instead of on the first bit.
+       For a field that needs strict alignment, issue the error for the
+       position first and, for the size, issue an error if it is too large
+       only for the atomic and aliased cases.  Issue a specific error if
+       the size is not a multiple of a byte in the volatile and the stric
+       alignment cases.
+
 2014-12-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/decl.c (check_ok_for_atomic): Rename into...

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index a50f1d30e9e949e0a6e124e4761a471e1d0b2067..fda3f0cc63e4a3647c0b4e9cd2831ef379c87e4f 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6414,12 +6414,14 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
   tree gnu_field_id = get_entity_name (gnat_field);
   tree gnu_field, gnu_size, gnu_pos;
+  bool is_aliased
+    = Is_Aliased (gnat_field);
+  bool is_atomic
+    = (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type));
   bool is_volatile
     = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
   bool needs_strict_alignment
-    = (is_volatile
-       || Is_Aliased (gnat_field)
-       || Strict_Alignment (gnat_field_type));
+    = (is_aliased || is_volatile || Strict_Alignment (gnat_field_type));
 
   /* If this field requires strict alignment, we cannot pack it because
      it would very likely be under-aligned in the record.  */
@@ -6488,6 +6490,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
 
   if (Present (Component_Clause (gnat_field)))
     {
+      Node_Id gnat_clause = Component_Clause (gnat_field);
       Entity_Id gnat_parent
        = Parent_Subtype (Underlying_Type (Scope (gnat_field)));
 
@@ -6506,91 +6509,95 @@ 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 ^}",
-                First_Bit (Component_Clause (gnat_field)), gnat_field,
-                TYPE_SIZE_UNIT (gnu_parent));
-           }
+           post_error_ne_tree
+             ("offset of& must be beyond parent{, minimum allowed is ^}",
+              Position (gnat_clause), gnat_field, TYPE_SIZE_UNIT (gnu_parent));
        }
 
-      /* If this field needs strict alignment, check that the record is
-        sufficiently aligned and that position and size are consistent with
-        the alignment.  But don't do it if we are just annotating types and
+      /* If this field needs strict alignment, make sure that the record is
+        sufficiently aligned and that the position and size are consistent
+        with the type.  But don't do it if we are just annotating types and
         the field's type is tagged, since tagged types aren't fully laid out
         in this mode.  Also, note that atomic implies volatile so the inner
         test sequences ordering is significant here.  */
       if (needs_strict_alignment
          && !(type_annotate_only && Is_Tagged_Type (gnat_field_type)))
        {
-         TYPE_ALIGN (gnu_record_type)
-           = MAX (TYPE_ALIGN (gnu_record_type), TYPE_ALIGN (gnu_field_type));
+         const unsigned int type_align = TYPE_ALIGN (gnu_field_type);
+
+         if (TYPE_ALIGN (gnu_record_type) < type_align)
+           TYPE_ALIGN (gnu_record_type) = type_align;
 
-         if (gnu_size
-             && !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0))
+         /* If the position is not a multiple of the alignment of the type,
+            then error out and reset the position.  */
+         if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
+                                         bitsize_int (type_align))))
            {
-             if (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type))
-               post_error_ne_tree
-                 ("atomic field& must be natural size of type{ (^)}",
-                  Last_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_SIZE (gnu_field_type));
+             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_volatile)
-               post_error_ne_tree
-                 ("volatile field& must be natural size of type{ (^)}",
-                  Last_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_SIZE (gnu_field_type));
-
-             else if (Is_Aliased (gnat_field))
-               post_error_ne_tree
-                 ("size of aliased field& must be ^ bits",
-                  Last_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_SIZE (gnu_field_type));
-
+               s = "position of volatile field& must be multiple of ^ bits";
              else if (Strict_Alignment (gnat_field_type))
-               post_error_ne_tree
-                 ("size of & with aliased or tagged components not ^ bits",
-                  Last_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_SIZE (gnu_field_type));
-
-              else
+               s = "position of & with aliased or tagged part must be"
+                   " multiple of ^ bits";
+             else
                gcc_unreachable ();
 
-             gnu_size = NULL_TREE;
+             post_error_ne_num (s, First_Bit (gnat_clause), gnat_field,
+                                type_align);
+             gnu_pos = NULL_TREE;
            }
 
-         if (!integer_zerop (size_binop
-                             (TRUNC_MOD_EXPR, gnu_pos,
-                              bitsize_int (TYPE_ALIGN (gnu_field_type)))))
+         if (gnu_size)
            {
-             if (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type))
-               post_error_ne_num
-                 ("position of atomic field& must be multiple of ^ bits",
-                  First_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_ALIGN (gnu_field_type));
-
-              else if (is_volatile)
-               post_error_ne_num
-                 ("position of volatile field& must be multiple of ^ bits",
-                  First_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_ALIGN (gnu_field_type));
-
-             else if (Is_Aliased (gnat_field))
-               post_error_ne_num
-                 ("position of aliased field& must be multiple of ^ bits",
-                  First_Bit (Component_Clause (gnat_field)), gnat_field,
-                  TYPE_ALIGN (gnu_field_type));
+             tree gnu_type_size = TYPE_SIZE (gnu_field_type);
+             const int cmp = tree_int_cst_compare (gnu_size, gnu_type_size);
 
-             else if (Strict_Alignment (gnat_field_type))
-               post_error_ne
-                 ("position of & is not compatible with alignment required "
-                  "by its components",
-                   First_Bit (Component_Clause (gnat_field)), gnat_field);
+             /* 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)))
+               {
+                 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_volatile)
+                   s = "size of volatile field& must be at least ^ bits";
+                 else if (Strict_Alignment (gnat_field_type))
+                   s = "size of & with aliased or tagged part must be"
+                       " at least ^ bits";
+                 else
+                   gcc_unreachable ();
 
-             else
-               gcc_unreachable ();
+                 post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field,
+                                     gnu_type_size);
+                 gnu_size = NULL_TREE;
+               }
 
-             gnu_pos = 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)))
+               {
+                 const char *s;
+
+                 if (is_volatile)
+                   s = "size of volatile field& must be multiple of"
+                       " Storage_Unit";
+                 else if (Strict_Alignment (gnat_field_type))
+                   s = "size of & with aliased or tagged part must be"
+                       " multiple of Storage_Unit";
+                 else
+                   gcc_unreachable ();
+
+                 post_error_ne (s, Last_Bit (gnat_clause), gnat_field);
+                 gnu_size = NULL_TREE;
+               }
            }
        }
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7ede224342e194747bcff439ae049c63deb3ef51..9e17c5cd3fc73e3a7d5b3ccbc2b0fc4d627b2338 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-12-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/volatile1.ads: New test.
+       * gnat.dg/specs/clause_on_volatile.ads: Adjust.
+       * gnat.dg/specs/size_clause3.ads: Likewise.
+
 2014-12-22  Bin Cheng  <bin.cheng@arm.com>
 
        PR rtl-optimization/62151

diff --git a/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads b/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads
index 4a046c15cbaf0355eb22bba8f772fe96a5a127c7..68799a757a2b48f69d2440474052f420fb49abe9 100644 (file)
--- a/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads
+++ b/gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads
@@ -21,7 +21,7 @@ package Clause_On_Volatile is
      W : Word;
   end record;
   for R1 use record
-     W at 0 range 0 .. 15; -- OK, packing regular
+     W at 0 range 0 .. 15; -- OK
   end record;
 
   type A1 is record
@@ -29,7 +29,7 @@ package Clause_On_Volatile is
   end record;
   For A1'Alignment use 4;
   for A1 use record
-     AW at 0 range 0 .. 15; -- { dg-error "must be natural size" }
+     AW at 0 range 0 .. 15; -- { dg-error "must be \[0-9\]*" }
   end record;
 
   type A2 is record
@@ -49,17 +49,15 @@ 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|natural size)" }
+     AW at 1 range 0 .. 15; -- { dg-error "must be (multiple||\[0-9\]*)" }
   end record;
 
-  --
-
   type V1 is record
      VW : Vword;
   end record;
   For V1'Alignment use 4;
   for V1 use record
-     VW at 0 range 0 .. 15; -- { dg-error "must be natural size" }
+     VW at 0 range 0 .. 15; -- { dg-error "must be at least" }
   end record;
 
   type V2 is record
@@ -79,7 +77,7 @@ package Clause_On_Volatile is
   For V3'Alignment use 4;
   for V3 use record
      B at 0 range 0 .. 7;
-     VW at 1 range 0 .. 15; -- { dg-error "must be (multiple|natural size)" }
+     VW at 1 range 0 .. 15; -- { dg-error "must be (multiple|at least)" }
   end record;
 
 end Clause_On_Volatile;

diff --git a/gcc/testsuite/gnat.dg/specs/size_clause3.ads b/gcc/testsuite/gnat.dg/specs/size_clause3.ads
index 6a89114e417db8670cba08d45bb3dbd07fb2f8d7..b7602d9527db636b50bb4b331b20c1bb2a719b91 100644 (file)
--- a/gcc/testsuite/gnat.dg/specs/size_clause3.ads
+++ b/gcc/testsuite/gnat.dg/specs/size_clause3.ads
@@ -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 component" }
+    rr at 0 range 0 .. 39;  -- { dg-error "size of .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 component" }
+    rr at 0 range 0 .. 39;  -- { dg-error "size of .rr. with aliased or tagged" }
   end record;
 
 end Size_Clause3;

diff --git a/gcc/testsuite/gnat.dg/specs/volatile1.ads b/gcc/testsuite/gnat.dg/specs/volatile1.ads
new file mode 100644 (file)
index 0000000..40ad480
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/volatile1.ads
@@ -0,0 +1,25 @@
+-- { dg-do compile }
+
+package Volatile1 is
+
+  C : Character;
+  for C'Size use 32;
+  pragma Volatile (C);
+
+  type R1 is record
+    C: Character;
+    pragma Volatile (C);
+  end record;
+  for R1 use record
+    C at 0 range 0 .. 31;
+  end record;
+
+  type R2 is record
+    C: Character;
+    pragma Volatile (C);
+  end record;
+  for R2 use record
+    C at 0 range 0 .. 10; -- { dg-error "size of volatile field" }
+  end record;
+
+end Volatile1;