-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
and then
Designated_Type (T1) = Designated_Type (T2))
or else (T1 = Any_Access
- and then Is_Access_Type (Underlying_Type (T2))))
+ and then Is_Access_Type (Underlying_Type (T2)))
+ or else (T2 = Any_Composite
+ and then
+ Is_Composite_Type (Underlying_Type (T1))))
then
return True;
-- Determine whether one of the candidates is an operation inherited by
-- a type that is derived from an actual in an instantiation.
+ function In_Generic_Actual (Exp : Node_Id) return Boolean;
+ -- Determine whether the expression is part of a generic actual. At
+ -- the time the actual is resolved the scope is already that of the
+ -- instance, but conceptually the resolution of the actual takes place
+ -- in the enclosing context, and no special disambiguation rules should
+ -- be applied.
+
function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
-- Determine whether a subprogram is an actual in an enclosing instance.
-- An overloading between such a subprogram and one declared outside the
-- pathology in the other direction with calls whose multiple overloaded
-- actuals make them truly unresolvable.
+ ------------------------
+ -- In_Generic_Actual --
+ ------------------------
+
+ function In_Generic_Actual (Exp : Node_Id) return Boolean is
+ Par : constant Node_Id := Parent (Exp);
+
+ begin
+ if No (Par) then
+ return False;
+
+ elsif Nkind (Par) in N_Declaration then
+ if Nkind (Par) = N_Object_Declaration
+ or else Nkind (Par) = N_Object_Renaming_Declaration
+ then
+ return Present (Corresponding_Generic_Association (Par));
+ else
+ return False;
+ end if;
+
+ elsif Nkind (Par) in N_Statement_Other_Than_Procedure_Call then
+ return False;
+
+ else
+ return In_Generic_Actual (Parent (Par));
+ end if;
+ end In_Generic_Actual;
+
---------------------------
-- Inherited_From_Actual --
---------------------------
-- case the resolution was to the explicit declaration in the
-- generic, and remains so in the instance.
- elsif In_Instance then
+ elsif In_Instance
+ and then not In_Generic_Actual (N)
+ then
if Nkind (N) = N_Function_Call
or else Nkind (N) = N_Procedure_Call_Statement
then
return True;
end if;
- E := Typ;
+ -- Handle private types
+
+ if Present (Full_View (Typ))
+ and then not Is_Concurrent_Type (Full_View (Typ))
+ then
+ E := Full_View (Typ);
+ else
+ E := Typ;
+ end if;
+
loop
if Present (Abstract_Interfaces (E))
and then Present (Abstract_Interfaces (E))
end loop;
end if;
- exit when Etype (E) = E;
+ exit when Etype (E) = E
+
+ -- Handle private types
+
+ or else (Present (Full_View (Etype (E)))
+ and then Full_View (Etype (E)) = E);
-- Check if the current type is a direct derivation of the
-- interface
return True;
end if;
- -- Climb to the immediate ancestor
+ -- Climb to the immediate ancestor handling private types
- E := Etype (E);
+ if Present (Full_View (Etype (E))) then
+ E := Full_View (Etype (E));
+ else
+ E := Etype (E);
+ end if;
end loop;
return False;
end Iface_Present_In_Ancestor;
+ -- Start of processing for Interface_Present_In_Ancestor
+
begin
if Is_Access_Type (Typ) then
Target_Typ := Etype (Directly_Designated_Type (Typ));
if Ekind (Target_Typ) = E_Incomplete_Type then
pragma Assert (Present (Non_Limited_View (Target_Typ)));
Target_Typ := Non_Limited_View (Target_Typ);
+
+ -- Protect the frontend against previously detected errors
+
+ if Ekind (Target_Typ) = E_Incomplete_Type then
+ return False;
+ end if;
end if;
return Iface_Present_In_Ancestor (Target_Typ);