Commit 0715a2a8 by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Renamed equality leads to spurious errors

The following patch corrects the search for the equality function to
handle cases where the equality could be a renaming of another routine.
No simple reproducer possible because this requires PolyORB.

2018-11-14  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_ch4.adb (Find_Aliased_Equality): New routine.
	(Find_Equality): Reimplemented.
	(Is_Equality): New routine.

From-SVN: r266121
parent b3b3ada9
2018-11-14 Hristian Kirtchev <kirtchev@adacore.com> 2018-11-14 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Find_Aliased_Equality): New routine.
(Find_Equality): Reimplemented.
(Is_Equality): New routine.
2018-11-14 Hristian Kirtchev <kirtchev@adacore.com>
* ghost.adb (Ghost_Entity): New routine. * ghost.adb (Ghost_Entity): New routine.
(Mark_And_Set_Ghost_Assignment): Reimplemented. (Mark_And_Set_Ghost_Assignment): Reimplemented.
* sem_ch5.adb (Analyze_Assignment): Assess whether the target of * sem_ch5.adb (Analyze_Assignment): Assess whether the target of
......
...@@ -7560,57 +7560,96 @@ package body Exp_Ch4 is ...@@ -7560,57 +7560,96 @@ package body Exp_Ch4 is
------------------- -------------------
function Find_Equality (Prims : Elist_Id) return Entity_Id is function Find_Equality (Prims : Elist_Id) return Entity_Id is
Formal_1 : Entity_Id; function Find_Aliased_Equality (Prim : Entity_Id) return Entity_Id;
Formal_2 : Entity_Id; -- Find an equality in a possible alias chain starting from primitive
Prim : Entity_Id; -- operation Prim.
Prim_Elmt : Elmt_Id;
begin function Is_Equality (Id : Entity_Id) return Boolean;
-- Assume that the tagged type lacks an equality -- Determine whether arbitrary entity Id denotes an equality
Prim := Empty; ---------------------------
-- Find_Aliased_Equality --
---------------------------
-- Inspect the list of primitives looking for a suitable equality function Find_Aliased_Equality (Prim : Entity_Id) return Entity_Id is
Candid : Entity_Id;
Prim_Elmt := First_Elmt (Prims); begin
while Present (Prim_Elmt) loop -- Inspect each candidate in the alias chain, checking whether it
-- denotes an equality.
-- Traverse a potential chain of derivations to recover the parent Candid := Prim;
-- equality. while Present (Candid) loop
if Is_Equality (Candid) then
return Candid;
end if;
Prim := Ultimate_Alias (Node (Prim_Elmt)); Candid := Alias (Candid);
end loop;
-- The current primitives denotes function "=" that returns a return Empty;
-- Boolean. This could be the suitable equality if the formal end Find_Aliased_Equality;
-- parameters agree.
if Ekind (Prim) = E_Function -----------------
and then Chars (Prim) = Name_Op_Eq -- Is_Equality --
and then Base_Type (Etype (Prim)) = Standard_Boolean -----------------
function Is_Equality (Id : Entity_Id) return Boolean is
Formal_1 : Entity_Id;
Formal_2 : Entity_Id;
begin
-- The equality function carries name "=", returns Boolean, and
-- has exactly two formal parameters of an identical type.
if Ekind (Id) = E_Function
and then Chars (Id) = Name_Op_Eq
and then Base_Type (Etype (Id)) = Standard_Boolean
then then
Formal_1 := First_Formal (Prim); Formal_1 := First_Formal (Id);
Formal_2 := Empty; Formal_2 := Empty;
if Present (Formal_1) then if Present (Formal_1) then
Formal_2 := Next_Formal (Formal_1); Formal_2 := Next_Formal (Formal_1);
end if; end if;
if Present (Formal_1) return
and then Present (Formal_2) Present (Formal_1)
and then Etype (Formal_1) = Etype (Formal_2) and then Present (Formal_2)
then and then Etype (Formal_1) = Etype (Formal_2)
exit; and then No (Next_Formal (Formal_2));
end if;
end if; end if;
return False;
end Is_Equality;
-- Local variables
Eq_Prim : Entity_Id;
Prim_Elmt : Elmt_Id;
-- Start of processing for Find_Equality
begin
-- Assume that the tagged type lacks an equality
Eq_Prim := Empty;
-- Inspect the list of primitives looking for a suitable equality
-- within a possible chain of aliases.
Prim_Elmt := First_Elmt (Prims);
while Present (Prim_Elmt) and then No (Eq_Prim) loop
Eq_Prim := Find_Aliased_Equality (Node (Prim_Elmt));
Next_Elmt (Prim_Elmt); Next_Elmt (Prim_Elmt);
end loop; end loop;
-- A tagged type should have an equality in its list of primitives -- A tagged type should always have an equality
pragma Assert (Present (Prim)); pragma Assert (Present (Eq_Prim));
return Prim; return Eq_Prim;
end Find_Equality; end Find_Equality;
------------------------------------ ------------------------------------
......
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