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 <ebotca...@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 <ebotca...@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 BotcazouIndex: 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;
