aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2018-05-28 08:55:52 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-05-28 08:55:52 +0000
commitbcad5029a8e4977013d7fadc133f22fbdf8dd99d (patch)
treee28ebd67d4e1632a6d6a5af6fce99c5572a2770f
parent4fd9587f7c4b77550b6a9a1045e2687fb5d77335 (diff)
downloadgcc-bcad5029a8e4977013d7fadc133f22fbdf8dd99d.zip
gcc-bcad5029a8e4977013d7fadc133f22fbdf8dd99d.tar.gz
gcc-bcad5029a8e4977013d7fadc133f22fbdf8dd99d.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/exp_ch4.adb26
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/renaming12.adb7
-rw-r--r--gcc/testsuite/gnat.dg/renaming12.ads23
5 files changed, 63 insertions, 3 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f6689b5..79df7a6 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 517a8da..e9ed0d8 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 a7edd01..b9c30ae 100644
--- 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
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
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;