[Ada] Fix internal error on renaming of equality for record type

This adjusts the previous change to the cases where the array type is not
yet frozen and, therefore, where Size_Depends_On_Discriminant is not yet
computed, by doing the computation manually.

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

gcc/ada/

	* exp_ch4.adb (Expand_Composite_Equality): Compute whether the size
	depends on a discriminant manually instead of using the predicate
	Size_Depends_On_Discriminant in the array type case.

gcc/testsuite/

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

From-SVN: r260839

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f6689b5..79df7a6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-05-28  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_ch4.adb (Expand_Composite_Equality): Compute whether the size
+       depends on a discriminant manually instead of using the predicate
+       Size_Depends_On_Discriminant in the array type case.
+
 2018-05-28  Ed Schonberg  <schonberg@adacore.com>
 
        * exp_unst.adb (Check_Static_Type): For a record subtype, check

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 517a8da..e9ed0d8 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -2435,6 +2435,10 @@ package body Exp_Ch4 is
          else
             declare
                Comp_Typ : Entity_Id;
+               Indx     : Node_Id;
+               Ityp     : Entity_Id;
+               Lo       : Node_Id;
+               Hi       : Node_Id;
 
             begin
                --  Do the comparison in the type (or its full view) and not in
@@ -2450,9 +2454,25 @@ package body Exp_Ch4 is
                --  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;
+               Indx := First_Index (Comp_Typ);
+               while Present (Indx) loop
+                  Ityp := Etype (Indx);
+
+                  Lo := Type_Low_Bound (Ityp);
+                  Hi := Type_High_Bound (Ityp);
+
+                  if (Nkind (Lo) = N_Identifier
+                       and then Ekind (Entity (Lo)) = E_Discriminant)
+                    or else
+                     (Nkind (Hi) = N_Identifier
+                       and then Ekind (Entity (Hi)) = E_Discriminant)
+                  then
+                     Comp_Typ := Full_Type;
+                     exit;
+                  end if;
+
+                  Next_Index (Indx);
+               end loop;
 
                return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Comp_Typ);
             end;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a7edd01..b9c30ae 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2018-05-28  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gnat.dg/renaming12.adb, gnat.dg/renaming12.ads: New testcase.
+
+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>

diff --git a/gcc/testsuite/gnat.dg/renaming12.adb b/gcc/testsuite/gnat.dg/renaming12.adb
new file mode 100644 (file)
index 0000000..15b1506
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/renaming12.adb
@@ -0,0 +1,7 @@
+--  { dg-do compile }
+
+package body Renaming12 is
+
+  procedure Dummy is null;
+
+end Renaming12;

diff --git a/gcc/testsuite/gnat.dg/renaming12.ads b/gcc/testsuite/gnat.dg/renaming12.ads
new file mode 100644 (file)
index 0000000..9c3ad7c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/renaming12.ads
@@ -0,0 +1,23 @@
+package Renaming12 is
+
+  type Index_Type is range 0 .. 40;
+
+  type Rec1 is record
+    B : Boolean;
+  end record;
+
+  type Arr is array (Index_Type range <>) of Rec1;
+
+  type Rec2 (Count : Index_Type := 0) is record
+    A : Arr (1 .. Count);
+  end record;
+
+  package Ops is
+
+    function "=" (L : Rec2; R : Rec2) return Boolean renames Renaming12."=";
+
+  end Ops;
+
+  procedure Dummy;
+
+end Renaming12;