[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 f6689b592d0f5ea7c2d6adba043f228bda4ef63d..79df7a63e145e2d68ddb8d73a340feed2bbdfb5a 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 517a8da65bdaa420111dd2f32c94fed5ab68d4e5..e9ed0d896261488c43f5711c47932076df273980 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 a7edd014a74e2a0d3020935e0be0611116ddf0c3..b9c30ae02e7cee896e3d6ad2044ea80b41358231 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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.

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;