[Ada] Illegal call on abstract operator

[Arnaud Charlet]

This patch fixes an obscure bug where gnat was failing to detect an illegal
call on an abstract operator. In particular, when the operands are of a
universal numeric type. This bug occurred only in Ada 2005 mode (and higher).

The following test should get an error:

illegal_abst_func.adb:5:24: cannot call abstract subprogram "+"

procedure Illegal_Abst_Func is
   type My_Integer is new Integer;
   function "+" (Left, Right: My_Integer) return My_Integer is abstract;

   X : My_Integer := 2 + 2; -- Illegal!

begin
   null;
end Illegal_Abst_Func;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-12-12  Bob Duff  <duff@adacore.com>

	* sem_res.adb (Resolve): Deal with the case where an abstract
	operator is called with operands of type universal_integer.

-------------- next part --------------
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 182223)
+++ sem_res.adb	(working copy)
@@ -1989,6 +1989,9 @@
       end if;
 
       Debug_A_Entry ("resolving  ", N);
+      if Debug_Flag_V then
+         Write_Overloads (N);
+      end if;
 
       if Comes_From_Source (N) then
          if Is_Fixed_Point_Type (Typ) then
@@ -2033,6 +2036,11 @@
          Get_First_Interp (N, I, It);
          Interp_Loop : while Present (It.Typ) loop
 
+            if Debug_Flag_V then
+               Write_Str ("Interp: ");
+               Write_Interp (It);
+            end if;
+
             --  We are only interested in interpretations that are compatible
             --  with the expected type, any other interpretations are ignored.
 
@@ -2054,6 +2062,10 @@
                  and then Typ /= Universal_Real
                  and then Present (It.Abstract_Op)
                then
+                  if Debug_Flag_V then
+                     Write_Line ("Skip.");
+                  end if;
+
                   goto Continue;
                end if;
 
@@ -2572,9 +2584,36 @@
          Resolution_Failed;
          return;
 
-      --  Here we have an acceptable interpretation for the context
+      else
+         --  In Ada 2005, if we have something like "X : T := 2 + 2;", where
+         --  the "+" on T is abstract, and the operands are of universal type,
+         --  the above code will have (incorrectly) resolved the "+" to the
+         --  universal one in Standard. Therefore, we check for this case, and
+         --  give an error. We can't do this earlier, because it would cause
+         --  legal cases to get errors (when some other type has an abstract
+         --  "+").
 
-      else
+         if Ada_Version >= Ada_2005 and then
+           Nkind (N) in N_Op and then
+           Is_Overloaded (N) and then
+           Is_Universal_Numeric_Type (Etype (Entity (N)))
+         then
+            Get_First_Interp (N, I, It);
+            while Present (It.Typ) loop
+               if Present (It.Abstract_Op) and then
+                 Etype (It.Abstract_Op) = Typ
+               then
+                  Error_Msg_NE
+                    ("cannot call abstract subprogram &!", N, It.Abstract_Op);
+                  return;
+               end if;
+
+               Get_Next_Interp (I, It);
+            end loop;
+         end if;
+
+         --  Here we have an acceptable interpretation for the context
+
          --  Propagate type information and normalize tree for various
          --  predefined operations. If the context only imposes a class of
          --  types, rather than a specific type, propagate the actual type