Comments
Patch
===================================================================
@@ -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
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 <schonberg@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.