Fix ICE on nested packed variant record type
This is a regression present on the mainline and 10 branch: the compiler aborts on code accessing a component of a packed record type whose type is a packed discriminated record type with variant part. gcc/ada/ChangeLog: * gcc-interface/utils.c (type_has_variable_size): New function. (create_field_decl): In the packed case, also force byte alignment when the type of the field has variable size. gcc/testsuite/ChangeLog: * gnat.dg/pack27.adb: New test. * gnat.dg/pack27_pkg.ads: New helper.
This commit is contained in:
parent
b5ffd55a61
commit
ef4ab841d9
@ -2905,6 +2905,31 @@ aggregate_type_contains_array_p (tree type, bool self_referential)
|
||||
}
|
||||
}
|
||||
|
||||
/* Return true if TYPE is a type with variable size or a padding type with a
|
||||
field of variable size or a record that has a field with such a type. */
|
||||
|
||||
static bool
|
||||
type_has_variable_size (tree type)
|
||||
{
|
||||
tree field;
|
||||
|
||||
if (!TREE_CONSTANT (TYPE_SIZE (type)))
|
||||
return true;
|
||||
|
||||
if (TYPE_IS_PADDING_P (type)
|
||||
&& !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
|
||||
return true;
|
||||
|
||||
if (!RECORD_OR_UNION_TYPE_P (type))
|
||||
return false;
|
||||
|
||||
for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
|
||||
if (type_has_variable_size (TREE_TYPE (field)))
|
||||
return true;
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Return a FIELD_DECL node. NAME is the field's name, TYPE is its type and
|
||||
RECORD_TYPE is the type of the enclosing record. If SIZE is nonzero, it
|
||||
is the specified size of the field. If POS is nonzero, it is the bit
|
||||
@ -2974,13 +2999,15 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
|
||||
|
||||
DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
|
||||
|
||||
/* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
|
||||
byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
|
||||
/* If FIELD_TYPE has BLKmode, we must ensure this is aligned to at least
|
||||
a byte boundary since GCC cannot handle less aligned BLKmode bitfields.
|
||||
Likewise if it has a variable size and no specified position because
|
||||
variable-sized objects need to be aligned to at least a byte boundary.
|
||||
Likewise for an aggregate without specified position that contains an
|
||||
array, because in this case slices of variable length of this array
|
||||
must be handled by GCC and variable-sized objects need to be aligned
|
||||
to at least a byte boundary. */
|
||||
array because, in this case, slices of variable length of this array
|
||||
must be handled by GCC and have variable size. */
|
||||
if (packed && (TYPE_MODE (type) == BLKmode
|
||||
|| (!pos && type_has_variable_size (type))
|
||||
|| (!pos
|
||||
&& AGGREGATE_TYPE_P (type)
|
||||
&& aggregate_type_contains_array_p (type, false))))
|
||||
|
10
gcc/testsuite/gnat.dg/pack27.adb
Normal file
10
gcc/testsuite/gnat.dg/pack27.adb
Normal file
@ -0,0 +1,10 @@
|
||||
-- { dg-do compile }
|
||||
|
||||
with Pack27_Pkg; use Pack27_Pkg;
|
||||
|
||||
procedure Pack27 is
|
||||
R1 : Rec1;
|
||||
R4 : Rec4;
|
||||
begin
|
||||
R4.R.R.R := R1;
|
||||
end;
|
33
gcc/testsuite/gnat.dg/pack27_pkg.ads
Normal file
33
gcc/testsuite/gnat.dg/pack27_pkg.ads
Normal file
@ -0,0 +1,33 @@
|
||||
pragma No_Component_Reordering;
|
||||
|
||||
package Pack27_Pkg is
|
||||
|
||||
type Enum is (One, Two, Three);
|
||||
|
||||
type Rec1 (D : Enum := One) is record
|
||||
case D is
|
||||
when One => null;
|
||||
when Two => null;
|
||||
when Three => C : Character;
|
||||
end case;
|
||||
end record;
|
||||
pragma Pack (Rec1);
|
||||
|
||||
type Rec2 is record
|
||||
R : Rec1;
|
||||
end record;
|
||||
pragma Pack (Rec2);
|
||||
|
||||
type Rec3 is record
|
||||
B : boolean;
|
||||
R : Rec2;
|
||||
end record;
|
||||
pragma Pack (Rec3);
|
||||
|
||||
type Rec4 is record
|
||||
B : Boolean;
|
||||
R : Rec3;
|
||||
end record;
|
||||
pragma Pack (Rec4);
|
||||
|
||||
end Pack27_Pkg;
|
Loading…
Reference in New Issue
Block a user