From 0c386027b7d086f4d8e0b7f5a3778db1d08e6a29 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 28 May 2018 08:54:55 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++ gcc/ada/exp_ch4.adb | 26 +++++++++++- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/rep_clause6.adb | 5 +++ gcc/testsuite/gnat.dg/rep_clause6.ads | 61 +++++++++++++++++++++++++++ 5 files changed, 101 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/rep_clause6.adb create mode 100644 gcc/testsuite/gnat.dg/rep_clause6.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5460ca4ccd1..b10bd6ea625 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-05-28 Eric Botcazou + + * 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 * einfo.ads, einfo.adb (Needs_Activation_Record): New flag on diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index caa64b96e41..508123dd13b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2428,12 +2428,34 @@ package body Exp_Ch4 is -- For composite component types, and floating-point types, use the -- 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 -- composite type recursively containing such fields. 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; -- Case of tagged record types diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5f9d7f840ea..a7edd014a74 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-28 Eric Botcazou + + * gnat.dg/rep_clause6.adb, gnat.dg/rep_clause6.ads: New testcase. + 2018-05-28 Ed Schonberg * gnat.dg/fixedpnt5.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/rep_clause6.adb b/gcc/testsuite/gnat.dg/rep_clause6.adb new file mode 100644 index 00000000000..6012ffea7e1 --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_clause6.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Rep_Clause6 is + procedure Dummy is null; +end Rep_Clause6; diff --git a/gcc/testsuite/gnat.dg/rep_clause6.ads b/gcc/testsuite/gnat.dg/rep_clause6.ads new file mode 100644 index 00000000000..6b0b0d044c6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/rep_clause6.ads @@ -0,0 +1,61 @@ +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; -- 2.30.2