[Ada] fix bug in handling of abstract operation

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

A call to an abstract operation can only occur in a dispatching context,
where the tag is determined dynamically. If the operation dispatches on
result, the context must impose a classwide type. An assignment is such
a context, but only if the left-hand side is a class-wide object. In the
absence of test to check that the left-hand side was classwide, the
compiled accepted the call, and the error was caught in the binder, as
an unsatisfied symbol in the call. The compiler now rejects the call
with the proper diagnostic.
Compiling the following package must generate the output:
--
pak.adb:4:12: call to abstract function must be dispatching
pak.adb:5:17: call to abstract function must be dispatching
pak.adb:6:16: call to abstract function must be dispatching
gnatmake: "pak.adb" compilation error
--
package Pak is
  type Typ is abstract tagged null record;
  function Func return Typ is abstract;
  procedure Proc (X : in out Typ);
end Pak;
--
package body Pak is
   procedure Proc (X : in out Typ) is
   begin
      X := Func;
      X := Typ'(Func);
      X := Typ(Func);
   end Proc;
end Pak;

This patch also improves the handling of infinite loop detection. Previously
any call to a non-library level call was considered unsafe, but we can
do a bit better, by checking scopes. Consider the following example,
remembering that we do not yet look inside subprogram bodies (we could
but that is a refinement for another day).

Here the call to safe is clearly OK (cannot modify x) even though
safe is not a library level subprogram.

     1. procedure z (m : integer) is
     2.    procedure y is
     3.
     4.       procedure safe is
     5.       begin
     6.          null;
     7.       end;
     8.
     9.    begin
    10.       declare
    11.          x : integer := m;
    12.          procedure not_safe is
    13.          begin
    14.             x := x - 1;
    15.          end;
    16.
    17.       begin
    18.          while x > 5 loop
                       |
        >>> warning: variable "x" is not modified in
            loop body, possible infinite loop

    19.             safe;
    20.          end loop;
    21.
    22.          while x > 5 loop
    23.             not_safe;
    24.          end loop;
    25.       end;
    26.    end;
    27. begin
    28.    null;
    29. end z;

 29 lines: No errors, 1 warning

2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb (Analyze_Assignment): Reject a right-hand side that is a
	tag-indeterminate call to an abstract function, when the left-hand side
	is not classwide.
	(Analyze_Loop_Statement): Improve detection of infinite loops

Attachment: difs
Description: Text document