Commit bcad5029 by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent 4fd9587f
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> 2018-05-28 Ed Schonberg <schonberg@adacore.com>
* exp_unst.adb (Check_Static_Type): For a record subtype, check * exp_unst.adb (Check_Static_Type): For a record subtype, check
......
...@@ -2435,6 +2435,10 @@ package body Exp_Ch4 is ...@@ -2435,6 +2435,10 @@ package body Exp_Ch4 is
else else
declare declare
Comp_Typ : Entity_Id; Comp_Typ : Entity_Id;
Indx : Node_Id;
Ityp : Entity_Id;
Lo : Node_Id;
Hi : Node_Id;
begin begin
-- Do the comparison in the type (or its full view) and not in -- Do the comparison in the type (or its full view) and not in
...@@ -2450,9 +2454,25 @@ package body Exp_Ch4 is ...@@ -2450,9 +2454,25 @@ package body Exp_Ch4 is
-- Except for the case where the bounds of the type depend on a -- Except for the case where the bounds of the type depend on a
-- discriminant, or else we would run into scoping issues. -- discriminant, or else we would run into scoping issues.
if Size_Depends_On_Discriminant (Comp_Typ) then Indx := First_Index (Comp_Typ);
Comp_Typ := Full_Type; while Present (Indx) loop
end if; 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); return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Comp_Typ);
end; end;
......
2018-05-28 Eric Botcazou <ebotcazou@adacore.com> 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. * gnat.dg/rep_clause6.adb, gnat.dg/rep_clause6.ads: New testcase.
2018-05-28 Ed Schonberg <schonberg@adacore.com> 2018-05-28 Ed Schonberg <schonberg@adacore.com>
......
-- { dg-do compile }
package body Renaming12 is
procedure Dummy is null;
end Renaming12;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment