Commit 0c386027 by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Fix internal error on nested record types with representation clause

This fixes a long-standing issue with the expansion of equality functions
generated for discriminated record types with variant part.  In this case
the front-end recursively expands equality functions for the composite
sub-components, in particular the array sub-components.

But it systematically uses the unconstrained base type for them, which leads
to both a more complex equality function, because of the need to compare
the bounds, and an additional unchecked conversion from type to base type.

Now this unchecked conversion may block a further expansion of the array
sub-component, for example if it is a large array of record types subject
to a component clause that causes it not to start on a byte boundary, and
thus may lead to an internal error downstream in the back-end.

2018-05-28  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_Composite_Equality): For a composite (or FP)
	component type, do not expand array equality using the unconstrained
	base type, except for the case where the bounds of the type depend on a
	discriminant.

gcc/testsuite/

	* gnat.dg/rep_clause6.adb, gnat.dg/rep_clause6.ads: New testcase.

From-SVN: r260834
parent c84205cd
2018-05-28 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch4.adb (Expand_Composite_Equality): For a composite (or FP)
component type, do not expand array equality using the unconstrained
base type, except for the case where the bounds of the type depend on a
discriminant.
2018-05-28 Ed Schonberg <schonberg@adacore.com> 2018-05-28 Ed Schonberg <schonberg@adacore.com>
* einfo.ads, einfo.adb (Needs_Activation_Record): New flag on * einfo.ads, einfo.adb (Needs_Activation_Record): New flag on
......
...@@ -2428,12 +2428,34 @@ package body Exp_Ch4 is ...@@ -2428,12 +2428,34 @@ package body Exp_Ch4 is
-- For composite component types, and floating-point types, use the -- For composite component types, and floating-point types, use the
-- expansion. This deals with tagged component types (where we use -- expansion. This deals with tagged component types (where we use
-- the applicable equality routine) and floating-point, (where we -- the applicable equality routine) and floating-point (where we
-- need to worry about negative zeroes), and also the case of any -- need to worry about negative zeroes), and also the case of any
-- composite type recursively containing such fields. -- composite type recursively containing such fields.
else else
return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Full_Type); declare
Comp_Typ : Entity_Id;
begin
-- Do the comparison in the type (or its full view) and not in
-- its unconstrained base type, because the latter operation is
-- more complex and would also require an unchecked conversion.
if Is_Private_Type (Typ) then
Comp_Typ := Underlying_Type (Typ);
else
Comp_Typ := Typ;
end if;
-- Except for the case where the bounds of the type depend on a
-- discriminant, or else we would run into scoping issues.
if Size_Depends_On_Discriminant (Comp_Typ) then
Comp_Typ := Full_Type;
end if;
return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Comp_Typ);
end;
end if; end if;
-- Case of tagged record types -- Case of tagged record types
......
2018-05-28 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/rep_clause6.adb, gnat.dg/rep_clause6.ads: New testcase.
2018-05-28 Ed Schonberg <schonberg@adacore.com> 2018-05-28 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/fixedpnt5.adb: New testcase. * gnat.dg/fixedpnt5.adb: New testcase.
......
-- { dg-do compile }
package body Rep_Clause6 is
procedure Dummy is null;
end Rep_Clause6;
package Rep_Clause6 is
type B1_Type is range 0 .. 2**1 - 1;
for B1_Type'Size use 1;
type U10_Type is range 0 .. 2**10 - 1;
for U10_Type'Size use 10;
type B5_Type is range 0 .. 2**5 - 1;
for B5_Type'Size use 5;
type B11_Type is range 0 .. 2**11 - 1;
for B11_Type'Size use 11;
type Rec1 is record
B1 : B1_Type;
U10 : U10_Type;
B5 : B5_Type;
end record;
for Rec1 use record
B1 at 0 range 0 .. 0;
U10 at 0 range 1 .. 10;
B5 at 0 range 11 .. 15;
end record;
for Rec1'Size use 16;
type Arr is array (1 .. 5) of Rec1;
for Arr'Size use 80;
subtype Header_Type is String (1 .. 16);
type Rec2 is record
Header : Header_Type;
Spare_5 : B5_Type;
Deleted_Reports : Arr;
Block_End : B11_Type;
end record;
for Rec2 use record
Header at 0 range 0 .. 127;
Spare_5 at 16 range 0 .. 4;
Deleted_Reports at 16 range 5 .. 84;
Block_End at 24 range 21 .. 31;
end record;
for Rec2'Size use 224;
type Enum is (A_Msg, B_Msg, C_Msg, D_Msg);
type Rec3 (Msg_Type : Enum := Enum'First) is record
case Msg_Type is
when A_Msg => A_M : Arr;
when B_Msg => B_M : Arr;
when C_Msg => C_M : Rec2;
when others => null;
end case;
end record;
procedure Dummy;
end Rep_Clause6;
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