This patch handles a rare case of accidental overloading in an instance, when
the profile of a subprogram body that depends on a formal type becomes
compatible with that of a homonym whose profile in the generic mentions the
actual type.
execution of inst.adb must yield:
expected T... In P (T)
expected Integer... In P (Integer)
expected Integer... In P (Integer)
expected Integer again... In P (Integer)
---
with Ada.Text_IO; use Ada.Text_IO;
with Gen;
procedure Inst is
package I is new Gen (Integer);
Z : integer := 15;
begin
Put ("expected T... ");
I.Do_T;
Put ("expected Integer... ");
I.Do_Integer;
Put ("expected Integer... ");
I.P (123);
Put ("expected Integer again... ");
I.P (Z);
end Inst;
---
generic
type T is private;
package Gen is
procedure P (X : Integer);
procedure Do_T;
procedure Do_Integer;
end Gen;
---
with Ada.Text_IO; use Ada.Text_IO;
package body Gen is
procedure P (X : T) is
begin
Put_Line ("In P (T)");
end P;
procedure P (X : Integer) is
begin
Put_Line ("In P (Integer)");
end P;
procedure Do_T is
X : T;
begin
P (X);
end Do_T;
procedure Do_Integer is
X : Integer;
begin
P (X);
end Do_Integer;
end Gen;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-06-12 Ed Schonberg <schonb...@adacore.com>
* sem_ch6.adb (Different_Generic_Profile): new predicate for
Find_Corresponding_Spec, to handle a rare case of accidental
overloading in an instance, when the profile of a subprogram body
that depends on a formal type becomes compatible with that of
a homonym whose profile in the generic mentions the actual type.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 188428)
+++ sem_ch6.adb (working copy)
@@ -7416,6 +7416,8 @@
-- The following is too permissive. A more precise test should
-- check that the generic actual is an ancestor subtype of the
-- other ???.
+ -- See code in Find_Corresponding_Spec that applies an additional
+ -- filter to handle accidental amiguities in instances.
return not Is_Generic_Actual_Type (T1)
or else not Is_Generic_Actual_Type (T2)
@@ -8148,6 +8150,46 @@
E : Entity_Id;
+ function Different_Generic_Profile (E : Entity_Id) return Boolean;
+ -- Even if fully conformant, a body may depend on a generic actual when
+ -- the spec does not, or vice versa, in which case they were distinct
+ -- entities in the generic.
+
+ -------------------------------
+ -- Different_Generic_Profile --
+ -------------------------------
+
+ function Different_Generic_Profile (E : Entity_Id) return Boolean is
+ F1, F2 : Entity_Id;
+
+ begin
+ if Ekind (E) = E_Function
+ and then Is_Generic_Actual_Type (Etype (E))
+ /= Is_Generic_Actual_Type (Etype (Designator))
+ then
+ return True;
+ end if;
+
+ F1 := First_Formal (Designator);
+ F2 := First_Formal (E);
+
+ while Present (F1) loop
+ if
+ Is_Generic_Actual_Type (Etype (F1))
+ /= Is_Generic_Actual_Type (Etype (F2))
+ then
+ return True;
+ end if;
+
+ Next_Formal (F1);
+ Next_Formal (F2);
+ end loop;
+
+ return False;
+ end Different_Generic_Profile;
+
+ -- Start of processing for Find_Corresponding_Spec
+
begin
E := Current_Entity (Designator);
while Present (E) loop
@@ -8163,13 +8205,12 @@
and then Type_Conformant (E, Designator))
then
-- Within an instantiation, we know that spec and body are
- -- subtype conformant, because they were subtype conformant
- -- in the generic. We choose the subtype-conformant entity
- -- here as well, to resolve spurious ambiguities in the
- -- instance that were not present in the generic (i.e. when
- -- two different types are given the same actual). If we are
- -- looking for a spec to match a body, full conformance is
- -- expected.
+ -- subtype conformant, because they were subtype conformant in
+ -- the generic. We choose the subtype-conformant entity here as
+ -- well, to resolve spurious ambiguities in the instance that
+ -- were not present in the generic (i.e. when two different
+ -- types are given the same actual). If we are looking for a
+ -- spec to match a body, full conformance is expected.
if In_Instance then
Set_Convention (Designator, Convention (E));
@@ -8188,6 +8229,9 @@
elsif not Subtype_Conformant (Designator, E) then
goto Next_Entity;
+
+ elsif Different_Generic_Profile (E) then
+ goto Next_Entity;
end if;
end if;
@@ -8218,12 +8262,12 @@
return E;
- -- If E is an internal function with a controlling result
- -- that was created for an operation inherited by a null
- -- extension, it may be overridden by a body without a previous
- -- spec (one more reason why these should be shunned). In that
- -- case remove the generated body if present, because the
- -- current one is the explicit overriding.
+ -- If E is an internal function with a controlling result that
+ -- was created for an operation inherited by a null extension,
+ -- it may be overridden by a body without a previous spec (one
+ -- more reason why these should be shunned). In that case
+ -- remove the generated body if present, because the current
+ -- one is the explicit overriding.
elsif Ekind (E) = E_Function
and then Ada_Version >= Ada_2005
@@ -8329,9 +8373,9 @@
renames Fully_Conformant_Expressions;
function FCL (L1, L2 : List_Id) return Boolean;
- -- Compare elements of two lists for conformance. Elements have to
- -- be conformant, and actuals inserted as default parameters do not
- -- match explicit actuals with the same value.
+ -- Compare elements of two lists for conformance. Elements have to be
+ -- conformant, and actuals inserted as default parameters do not match
+ -- explicit actuals with the same value.
function FCO (Op_Node, Call_Node : Node_Id) return Boolean;
-- Compare an operator node with a function call
@@ -8356,8 +8400,8 @@
N2 := First (L2);
end if;
- -- Compare two lists, skipping rewrite insertions (we want to
- -- compare the original trees, not the expanded versions!)
+ -- Compare two lists, skipping rewrite insertions (we want to compare
+ -- the original trees, not the expanded versions!)
loop
if Is_Rewrite_Insertion (N1) then
