diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2018-05-28 08:55:52 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-05-28 08:55:52 +0000 |
commit | bcad5029a8e4977013d7fadc133f22fbdf8dd99d (patch) | |
tree | e28ebd67d4e1632a6d6a5af6fce99c5572a2770f | |
parent | 4fd9587f7c4b77550b6a9a1045e2687fb5d77335 (diff) | |
download | gcc-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/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 26 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/renaming12.adb | 7 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/renaming12.ads | 23 |
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; |