[Ada] fixes in handling of checks

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

This patch suppresses the warning for unmodified in-out parameters with
-gnatwk if the subprogram in question has its address taken, or is used
as a generic actual.

The patch is a little more involved than might be expected, because it is
necessary to delay the issuing of these warnigs until the whole unit has
been processed, since the access or generic use will appear after the
body has been processed.

The following test program shows the patch in action (compile with -gnatwk)

     1. procedure q is
     2.    G : Integer;
     3.    type r is access procedure (N : in out Integer);
     4.
     5.    procedure m (N : in out Integer) is begin G := N; end;
     6.    procedure n (N : in out Integer) is begin G := N; end;
     7.    procedure p (N : in out Integer) is begin G := N; end;
                        |
        >>> warning: formal parameter "N" is not modified
        >>> warning: mode could be "in" instead of "in out"

     8.
     9.    rr : r := m'access;
    10.
    11.    generic
    12.       with procedure x (N : in out Integer);
    13.    package xx is end;
    14.
    15.    package xxx is new xx (n);
    16.
    17. begin
    18.    null;
    19. end;

This patch also contains the folllowing changes:

First, the local and global check suppress stacks are now
implemented as linked lists. The reason for this is that we
have to save the state of the local suppress stack for generic
instantiations, and the linked list implementation allows
capturing the state by just having a pointer to the entry
in question (the "stack" ends up being a tree of stacks).

The RM requires that an instance be compiled using the checks
in effect at the point of instantiation. We simply were not
doing this at all before, and had no mechanism for doing this.
The check suppress state is now saved in the Pending_Body_Info
record, from whence it can be restored before instantiating
the body. The following example is a test program showing that
the patch fixes this bug:

Compile and run this example with a gnat.adc file containing:
pragma Suppress (All_Checks);

procedure r is
   subtype x is integer range 1 .. 10;
   y : integer := 11;

   generic package g is
      procedure ggg;
   end g;

   package body g is
      procedure ggg is
         r : x;
         b : boolean := Range_Check'Enabled;
      begin
         r := y;
      end ggg;
   end g;

   procedure p1 is
      package g1 is new g;
   begin
      g1.ggg;
   end;

   procedure p2 is
      pragma Unsuppress (All_Checks);
      package g2 is new g;
   begin
      g2.ggg;
   end;
begin
   p1;
   p2;
end;

Before this patch, the above program did not raise an exception
because the pragma Unsuppress was not properly inherited by the
instance. After the patch, the output of the program is:

raised CONSTRAINT_ERROR : r.adb:14 range check failed

The second major part of the patch is the implementation of
a new configuration pragma Check_Name, which can be used to
introduce a new check, and an attribute Check_Name'Enabled
which can be used to check if a check name (either one of
the predefined ones, or one introduced by pragma Check_Name)
is enabled at the point of the test (this is evaluated at
compile time).

A test of this facility is as follows:

pragma Check_Name (Alpha);
with Text_IO; use Text_IO;

procedure q is
   A, B : Integer;

begin
   Put_Line ("T " & Boolean'Image (Alpha'Enabled));
   Put_Line ("T " & Boolean'Image (Storage_Check'Enabled));

   declare
      pragma Suppress (Alpha);
      pragma Suppress (Storage_Check);

   begin
      Put_Line ("F " & Boolean'Image (Alpha'Enabled));
      Put_Line ("F " & Boolean'Image (Storage_Check'Enabled));

      declare
         pragma Unsuppress (Alpha, A);
         pragma Unsuppress (Storage_Check, A);

      begin
         Put_Line ("F " & Boolean'Image (Alpha'Enabled));
         Put_Line ("T " & Boolean'Image (Alpha'Enabled (A)));
         Put_Line ("F " & Boolean'Image (Alpha'Enabled (B)));

         Put_Line ("F " & Boolean'Image (Storage_Check'Enabled));
         Put_Line ("T " & Boolean'Image (Storage_Check'Enabled (A)));
         Put_Line ("F " & Boolean'Image (Storage_Check'Enabled (B)));

         declare
            pragma Suppress (Alpha, A);
            pragma Suppress (Storage_Check, A);

         begin
            Put_Line ("F " & Boolean'Image (Alpha'Enabled (A)));
            Put_Line ("F " & Boolean'Image (Storage_Check'Enabled (A)));
         end;

         Put_Line ("F " & Boolean'Image (Alpha'Enabled));
         Put_Line ("T " & Boolean'Image (Alpha'Enabled (A)));
         Put_Line ("F " & Boolean'Image (Alpha'Enabled (B)));

         Put_Line ("F " & Boolean'Image (Storage_Check'Enabled));
         Put_Line ("T " & Boolean'Image (Storage_Check'Enabled (A)));
         Put_Line ("F " & Boolean'Image (Storage_Check'Enabled (B)));
      end;

      Put_Line ("F " & Boolean'Image (Alpha'Enabled));
      Put_Line ("F " & Boolean'Image (Storage_Check'Enabled));
   end;

   Put_Line ("T " & Boolean'Image (Alpha'Enabled));
   Put_Line ("T " & Boolean'Image (Storage_Check'Enabled));
end;

When run, this generates:

T TRUE
T TRUE
F FALSE
F FALSE
F FALSE
T TRUE
F FALSE
F FALSE
T TRUE
F FALSE
F FALSE
F FALSE
F FALSE
T TRUE
F FALSE
F FALSE
T TRUE
F FALSE
F FALSE
F FALSE
T TRUE
T TRUE

(this test should be run without using -gnatp or a configuration
pragma suppressing All_Checks in gnat.adc).

2007-08-14  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* inline.adb, types.ads, inline.ads, frontend.adb, alloc.ads: 
	Suppress unmodified in-out parameter warning in some cases
	This patch is a also fairly significant change to the way suppressible
	checks are handled.

	* checks.ads, checks.adb (Install_Null_Excluding_Check): No check
	needed for access to concurrent record types generated by the expander.
	(Generate_Range_Check): When generating a temporary to capture the
	value of a conversion that requires a range check, set the type of the
	temporary before rewriting the node, so that the type is always
	properly placed for back-end use.
	(Apply_Float_Conversion_Check): Handle case where the conversion is
	truncating.
	(Get_Discriminal): Code reformatting. Climb the scope stack looking
	for a protected type in order to examine its discriminants.

Attachment: difs
Description: Text document