From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 28 May 2018 08:55:52 +0000 (+0000)
Subject: [Ada] Fix internal error on renaming of equality for record type
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=bcad5029a8e4977013d7fadc133f22fbdf8dd99d;p=gcc.git

[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 f6689b592d0..79df7a63e14 100644
--- 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 517a8da65bd..e9ed0d89626 100644
--- 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 a7edd014a74..b9c30ae02e7 100644
--- 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
index 00000000000..15b15068d08
--- /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
index 00000000000..9c3ad7cb818
--- /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;