mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 10:50:51 +08:00
Code Issues Packages Projects Releases Wiki Activity

[Ada] Wrong resolution of universal_access = operators

Browse Source 
gcc/ada/

	* sem_type.adb (Add_One_Interp.Is_Universal_Operation): Account
	for universal_access = operator.
	(Disambiguate): Take into account preference on universal_access
	= operator when relevant.
	(Disambiguate.Is_User_Defined_Anonymous_Access_Equality): New.
This commit is contained in:
Arnaud Charlet 2020-10-02 11:20:23 -04:00 committed by Pierre-Marie de Rodat
parent 13209acd64
commit fa65696761
1 changed files with 88 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
gcc/ada/sem_type.adb
View File

@ -326,8 +326,19 @@ package body Sem_Type is
return False;
elsif Nkind (N) in N_Binary_Op then
return Present (Universal_Interpretation (Left_Opnd (N)))
and then Present (Universal_Interpretation (Right_Opnd (N)));
if Present (Universal_Interpretation (Left_Opnd (N)))
and then Present (Universal_Interpretation (Right_Opnd (N)))
then
return True;
elsif Nkind (N) in N_Op_Eq | N_Op_Ne
and then
(Is_Anonymous_Access_Type (Etype (Left_Opnd (N)))
or else Is_Anonymous_Access_Type (Etype (Right_Opnd (N))))
then
return True;
else
return False;
end if;
elsif Nkind (N) in N_Unary_Op then
return Present (Universal_Interpretation (Right_Opnd (N)));
@ -1338,6 +1349,13 @@ package body Sem_Type is
-- for special handling of expressions with universal operands, see
-- comments to Has_Abstract_Interpretation below.
function Is_User_Defined_Anonymous_Access_Equality
(User_Subp, Predef_Subp : Entity_Id) return Boolean;
-- Check for Ada 2005, AI-020: If the context involves an anonymous
-- access operand, recognize a user-defined equality (User_Subp) with
-- the proper signature, declared in the same declarative list as the
-- type and not hiding a predefined equality Predef_Subp.
---------------------------
-- Inherited_From_Actual --
---------------------------
@ -1743,6 +1761,37 @@ package body Sem_Type is
end if;
end Standard_Operator;
-----------------------------------------------
-- Is_User_Defined_Anonymous_Access_Equality --
-----------------------------------------------
function Is_User_Defined_Anonymous_Access_Equality
(User_Subp, Predef_Subp : Entity_Id) return Boolean is
begin
return Present (User_Subp)
-- Check for Ada 2005 and use of anonymous access
and then Ada_Version >= Ada_2005
and then Etype (User_Subp) = Standard_Boolean
and then Is_Anonymous_Access_Type (Operand_Type)
-- This check is only relevant if User_Subp is visible and not in
-- an instance
and then (In_Open_Scopes (Scope (User_Subp))
or else Is_Potentially_Use_Visible (User_Subp))
and then not In_Instance
and then not Hides_Op (User_Subp, Predef_Subp)
-- Is User_Subp declared in the same declarative list as the type?
and then
In_Same_Declaration_List
(Designated_Type (Operand_Type),
Unit_Declaration_Node (User_Subp));
end Is_User_Defined_Anonymous_Access_Equality;
-- Start of processing for Disambiguate
begin
@ -1856,17 +1905,41 @@ package body Sem_Type is
Arg2 := Next_Actual (Arg1);
end if;
if Present (Arg2)
and then Present (Universal_Interpretation (Arg1))
and then Universal_Interpretation (Arg2) =
Universal_Interpretation (Arg1)
then
Get_First_Interp (N, I, It);
while Scope (It.Nam) /= Standard_Standard loop
Get_Next_Interp (I, It);
end loop;
if Present (Arg2) then
if Ekind (Nam1) = E_Operator then
Predef_Subp := Nam1;
User_Subp := Nam2;
elsif Ekind (Nam2) = E_Operator then
Predef_Subp := Nam2;
User_Subp := Nam1;
else
Predef_Subp := Empty;
User_Subp := Empty;
end if;
return It;
-- Take into account universal interpretation as well as
-- universal_access equality, as long as AI05-0020 does not
-- trigger.
if (Present (Universal_Interpretation (Arg1))
and then Universal_Interpretation (Arg2) =
Universal_Interpretation (Arg1))
or else
(Nkind (N) in N_Op_Eq | N_Op_Ne
and then (Is_Anonymous_Access_Type (Etype (Arg1))
or else
Is_Anonymous_Access_Type (Etype (Arg2)))
and then not
Is_User_Defined_Anonymous_Access_Equality
(User_Subp, Predef_Subp))
then
Get_First_Interp (N, I, It);
while Scope (It.Nam) /= Standard_Standard loop
Get_Next_Interp (I, It);
end loop;
return It;
end if;
end if;
end;
end if;
@ -2117,20 +2190,11 @@ package body Sem_Type is
return It2;
end if;
-- Ada 2005, AI-420: preference rule for "=" on Universal_Access
-- states that the operator defined in Standard is not available
-- if there is a user-defined equality with the proper signature,
-- declared in the same declarative list as the type. The node
-- may be an operator or a function call.
-- Check for AI05-020
elsif Chars (Nam1) in Name_Op_Eq | Name_Op_Ne
and then Ada_Version >= Ada_2005
and then Etype (User_Subp) = Standard_Boolean
and then Is_Anonymous_Access_Type (Operand_Type)
and then
In_Same_Declaration_List
(Designated_Type (Operand_Type),
Unit_Declaration_Node (User_Subp))
and then Is_User_Defined_Anonymous_Access_Equality
(User_Subp, Predef_Subp)
then
if It2.Nam = Predef_Subp then
return It1;