re PR ada/15604 (Ambiguous aggregate -- Accepts invalid)
2005-11-14 Ed Schonberg <schonberg@adacore.com> Javier Miranda <miranda@adacore.com> PR ada/15604 * sem_type.adb (Covers): In an inlined body, a composite type matches a private type whose full view is a composite type. (Interface_Present_In_Ancestor): Protect the frontend against previously detected errors to ensure that its compilation with assertions enabled gives the same output that its compilation without assertions. (Interface_Present_In_Ancestor): Add support for private types. Change name In_Actual to In_Generic_Actual (clean up) (Disambiguate): New predicate In_Actual, to recognize expressions that appear in the renaming declaration generated for generic actuals, and which must be resolved in the outer context. From-SVN: r107006
This commit is contained in:
parent
9ebe37436f
commit
861d669e3d
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
@ -913,7 +913,10 @@ package body Sem_Type is
|
|||
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;
|
||||
|
||||
|
@ -979,6 +982,13 @@ package body Sem_Type is
|
|||
-- 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
|
||||
|
@ -1009,6 +1019,34 @@ package body Sem_Type is
|
|||
-- 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 --
|
||||
---------------------------
|
||||
|
@ -1372,7 +1410,9 @@ package body Sem_Type is
|
|||
-- 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
|
||||
|
@ -1801,7 +1841,16 @@ package body Sem_Type is
|
|||
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))
|
||||
|
@ -1819,7 +1868,12 @@ package body Sem_Type is
|
|||
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
|
||||
|
@ -1828,14 +1882,20 @@ package body Sem_Type is
|
|||
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));
|
||||
|
@ -1879,6 +1939,12 @@ package body Sem_Type is
|
|||
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);
|
||||
|
|
Loading…
Reference in New Issue