Skip to content

R
riscv-gcc-1
Commit 26cf7899 by Eric Botcazou Committed by Eric Botcazou
Options

decl.c (gnat_to_gnu_field): Rework error messages for fields requiring strict alignment... 

	* 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
parent 4ed9ab2d
Showing with 73 additions and 58 deletions
gcc/ada/ChangeLog
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.
......
gcc/ada/gcc-interface/decl.c
......@@ -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;
}
}
......
gcc/testsuite/ChangeLog
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.
......
gcc/testsuite/gnat.dg/specs/atomic2.ads
......@@ -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
......
gcc/testsuite/gnat.dg/specs/clause_on_volatile.ads
......@@ -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
......
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" }
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment