[Ada] Wrong warning when instantiating Container in generic unit

Message ID 20101011092721.GA11566@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 11, 2010, 9:27 a.m.
The compiler issues a spurious warning on a subprogram declared within
the body of an instance of a predefined Container package such as Doubly_
Linked_Lists (or other generic instance with a tagged type having a
nonprimitive operation of the type declared in the instance body) when
the instantiation itself occurs within a generic unit. The condition for
the warning was to test that the type is not yet frozen, but in the described
case, the type is not frozen by the instance body, leading to the wrong
warning. An extra condition is added, to only issue the warning when the
tagged type and the subprogram are declared in the same declaration list
(such as in a body, which in any event is the kind of case targeted by
the warning).

The following test must compile quietly with -gnat05:

with Ada.Containers.Doubly_Linked_Lists;

package Bad_Instance_Warning is

   type My_Abstract_Type is abstract tagged private;
   type My_Access is access all My_Abstract_Type;
   procedure P;
   type My_Abstract_Type is abstract tagged null record;
   package Listener_List is new Ada.Containers.Doubly_Linked_Lists (My_Access);
end Bad_Instance_Warning;

package body Bad_Instance_Warning is

   procedure P is
   end P;

end Bad_Instance_Warning;

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

2010-10-11  Gary Dismukes  <dismukes@adacore.com>

	* sem_disp.adb (Check_Dispatching_Operation): When testing for issuing
	a warning about subprograms of a tagged type not being dispatching,
	limit this to cases where the tagged type and the subprogram are
	declared within the same declaration list.


Index: sem_disp.adb
--- sem_disp.adb	(revision 165283)
+++ sem_disp.adb	(working copy)
@@ -1044,9 +1044,16 @@  package body Sem_Disp is
          --  If the type is not frozen yet and we are not in the overriding
          --  case it looks suspiciously like an attempt to define a primitive
          --  operation, which requires the declaration to be in a package spec
-         --  (3.2.3(6)).
-         elsif not Is_Frozen (Tagged_Type) then
+         --  (3.2.3(6)). Only report cases where the type and subprogram are
+         --  in the same declaration list (by comparing the unit nodes reached
+         --  via Parent links), to avoid spurious warnings on subprograms in
+         --  instance bodies when the type is declared in the instance spec but
+         --  hasn't been frozen by the instance body.
+         elsif not Is_Frozen (Tagged_Type)
+           and then
+             Parent (Parent (Tagged_Type)) = Parent (Parent (Parent (Subp)))
+         then
               ("?not dispatching (must be defined in a package spec)", Subp);