From fa65696761c167412262779e37fc15306e08dd1b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 2 Oct 2020 11:20:23 -0400 Subject: [PATCH] [Ada] Wrong resolution of universal_access = operators 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. --- gcc/ada/sem_type.adb | 112 +++++++++++++++++++++++++++++++++---------- 1 file changed, 88 insertions(+), 24 deletions(-) diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 3b1f48e02f7..4b5224938af 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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; -- 2.30.2