-- --
-- 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- --
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;
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;
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)
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.
-- 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,
-- 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.
------------------------
return False;
end Has_Abstract_Interpretation;
- -- Start of processing for Remove_ConversionsMino
+ -- Start of processing for Remove_Conversions
begin
It1 := No_Interp;
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;
-- 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);
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;