Patchwork [Ada] Accidental overlodading in an instance

login
register
mail settings
Submitter Arnaud Charlet
Date June 12, 2012, 10:03 a.m.
Message ID <20120612100347.GA5756@adacore.com>
Download mbox | patch
Permalink /patch/164364/
State New
Headers show

Comments

Arnaud Charlet - June 12, 2012, 10:03 a.m.
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.

Patch

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