[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5460ca4ccd1a9d4fb1d76e765d9b8e11c1ab6694..b10bd6ea62541e780a32b147a1a95803017aef66 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+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>
 
        * 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 caa64b96e41a3e9481409981bdc1217a073b5e7c..508123dd13b70362dccd74b8c6800ff544e7c9fa 100644 (file)
--- 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 5f9d7f840ea80e351cd7eafab88fe6b21c9c0ed6..a7edd014a74e2a0d3020935e0be0611116ddf0c3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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>
 
        * 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 (file)
index 0000000..6012ffe
--- /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 (file)
index 0000000..6b0b0d0
--- /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;