[Ada] PR ada/15604
Arnaud Charlet
charlet@adacore.com
Tue Nov 15 14:42:00 GMT 2005
Tested on i686-linux, committed on trunk
Fixes PR ada/15604
Spurious ambiguities can appear in instances, for example when two
subprogram declarations have different signatures in a generic, but
identical actual types give them same signatures in an instance. Special
disambiguation rules apply in such cases. However, actuals for generic
objects are not within the scope of the instance, and these special
disambiguation rules do not apply to them, even though they are analyzed
as part of renaming declarations that appear in the instance. Previously,
application of these disambiguation rules improperly accepted expressions
in actuals that were truly ambiguous. This is now fixed, and the following
program must not compile:
--
package Test_244496 is
type T1 is array (boolean) of float;
type T2 is array (boolean) of integer;
function f1 (x: T1) return integer;
function f1 (y: T2) return integer;
generic z: integer; package Q is end Q;
package new_Q is new Q (z => f1((1.0, 2.0))); -- ERROR: ambiguous
end Test_244496;
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.
-------------- next part --------------
Index: sem_type.adb
===================================================================
--- sem_type.adb (revision 106884)
+++ sem_type.adb (working copy)
@@ -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 @@
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 @@
-- 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 @@
-- 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 @@
-- 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 @@
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,8 +1868,13 @@
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 @@
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 @@
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);
More information about the Gcc-patches
mailing list