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 <d...@adacore.com>
* sem_res.adb (Resolve): Deal with the case where an abstract
operator is called with operands of type universal_integer.
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
