From 4e73070af6d0d5091ac78966a6bd3b43c861c904 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 15 Feb 2006 10:45:29 +0100 Subject: [PATCH] sem_type.adb (Write_Overloads): Improve display of candidate interpretations. 2006-02-13 Ed Schonberg Javier Miranda * sem_type.adb (Write_Overloads): Improve display of candidate interpretations. (Add_One_Interp): Do not add to the list of interpretations aliased entities corresponding with an abstract interface type that is an immediate ancestor of a tagged type; otherwise we have a dummy conflict between this entity and the aliased entity. (Disambiguate): The predefined equality on universal_access is not usable if there is a user-defined equality with the proper signature, declared in the same declarative part as the designated type. (Find_Unique_Type): The universal_access equality operator defined under AI-230 does not cover pool specific access types. (Covers): If one of the types is a generic actual subtype, check whether it matches the partial view of the other type. From-SVN: r111096 --- gcc/ada/sem_type.adb | 105 +++++++++++++++++++++++++++++++++++++++---- 1 file changed, 97 insertions(+), 8 deletions(-) diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index b4218db925e..cedd4c51483 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,8 +32,10 @@ with Elists; use Elists; with Nlists; use Nlists; with Errout; use Errout; with Lib; use Lib; +with Namet; use Namet; with Opt; use Opt; with Output; use Output; +with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; @@ -385,7 +387,20 @@ package body Sem_Type is and then Is_Subprogram (E) and then Present (Abstract_Interface_Alias (E)) then - Add_One_Interp (N, Abstract_Interface_Alias (E), T); + -- Ada 2005 (AI-251): If this primitive operation corresponds with + -- an inmediate ancestor interface there is no need to add it to the + -- list of interpretations; the corresponding aliased primitive is + -- also in this list of primitive operations and will be used instead + -- because otherwise we have a dummy between the two subprograms that + -- are in fact the same. + + if Present (DTC_Entity (Abstract_Interface_Alias (E))) + and then Etype (DTC_Entity (Abstract_Interface_Alias (E))) + /= RTE (RE_Tag) + then + Add_One_Interp (N, Abstract_Interface_Alias (E), T); + end if; + return; end if; @@ -896,6 +911,10 @@ package body Sem_Type is then return True; + -- In instances, or with types exported from instantiations, check + -- whether a partial and a full view match. Verify that types are + -- legal, to prevent cascaded errors. + elsif In_Instance and then (Full_View_Covers (T1, T2) @@ -903,6 +922,18 @@ package body Sem_Type is then return True; + elsif Is_Type (T2) + and then Is_Generic_Actual_Type (T2) + and then Full_View_Covers (T1, T2) + then + return True; + + elsif Is_Type (T1) + and then Is_Generic_Actual_Type (T1) + and then Full_View_Covers (T2, T1) + then + return True; + -- In the expansion of inlined bodies, types are compatible if they -- are structurally equivalent. @@ -1000,7 +1031,9 @@ package body Sem_Type is -- ambiguities when two formal types have the same actual. function Standard_Operator return Boolean; - -- Comment required ??? + -- Check whether subprogram is predefined operator declared in Standard. + -- It may given by an operator name, or by an expanded name whose prefix + -- is Standard. function Remove_Conversions return Interp; -- Last chance for pathological cases involving comparisons on literals, @@ -1019,8 +1052,8 @@ package body Sem_Type is -- pathology in the other direction with calls whose multiple overloaded -- actuals make them truly unresolvable. - -- The new rules concerning abstract operations create additional - -- for special handling of expressions with universal operands, See + -- The new rules concerning abstract operations create additional need + -- for special handling of expressions with universal operands, see -- comments to Has_Abstract_Interpretation below. ------------------------ @@ -1139,7 +1172,7 @@ package body Sem_Type is return False; end Has_Abstract_Interpretation; - -- Start of processing for Remove_ConversionsMino + -- Start of processing for Remove_Conversions begin It1 := No_Interp; @@ -1590,6 +1623,43 @@ package body Sem_Type is else 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. + + elsif (Chars (Nam1) = Name_Op_Eq + or else + Chars (Nam1) = Name_Op_Ne) + and then Ada_Version >= Ada_05 + and then Etype (User_Subp) = Standard_Boolean + then + declare + Opnd : Node_Id; + begin + if Nkind (N) = N_Function_Call then + Opnd := First_Actual (N); + else + Opnd := Left_Opnd (N); + end if; + + if Ekind (Etype (Opnd)) = E_Anonymous_Access_Type + and then + List_Containing (Parent (Designated_Type (Etype (Opnd)))) + = List_Containing (Unit_Declaration_Node (User_Subp)) + then + if It2.Nam = Predef_Subp then + return It1; + else + return It2; + end if; + else + return No_Interp; + end if; + end; + else return No_Interp; end if; @@ -1700,15 +1770,25 @@ package body Sem_Type is -- function "=" (L, R : universal_access) return Boolean; -- function "/=" (L, R : universal_access) return Boolean; + -- Pool specific access types (E_Access_Type) are not covered by these + -- operators because of the legality rule of 4.5.2(9.2): "The operands + -- of the equality operators for universal_access shall be convertible + -- to one another (see 4.6)". For example, considering the type decla- + -- ration "type P is access Integer" and an anonymous access to Integer, + -- P is convertible to "access Integer" by 4.6 (24.11-24.15), but there + -- is no rule in 4.6 that allows "access Integer" to be converted to P. + elsif Ada_Version >= Ada_05 and then Ekind (Etype (L)) = E_Anonymous_Access_Type and then Is_Access_Type (Etype (R)) + and then Ekind (Etype (R)) /= E_Access_Type then return Etype (L); elsif Ada_Version >= Ada_05 and then Ekind (Etype (R)) = E_Anonymous_Access_Type and then Is_Access_Type (Etype (L)) + and then Ekind (Etype (L)) /= E_Access_Type then return Etype (R); @@ -2731,11 +2811,20 @@ package body Sem_Type is Get_First_Interp (N, I, It); Write_Str ("Overloaded entity "); Write_Eol; + Write_Str (" Name Type"); + Write_Eol; + Write_Str ("==============================="); + Write_Eol; Nam := It.Nam; while Present (Nam) loop - Write_Entity_Info (Nam, " "); - Write_Str ("================="); + Write_Int (Int (Nam)); + Write_Str (" "); + Write_Name (Chars (Nam)); + Write_Str (" "); + Write_Int (Int (It.Typ)); + Write_Str (" "); + Write_Name (Chars (It.Typ)); Write_Eol; Get_Next_Interp (I, It); Nam := It.Nam; -- 2.30.2