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