diff mbox

[Ada] Implement -gnat-p switch (cancel previous -gnatp)

Message ID 20100616162528.GA27707@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 16, 2010, 4:25 p.m. UTC
This patch implements a new switch -gnat-p which cancels the effect of
a previous -gnatp switch. The following test program:

procedure GnatMP is
   N : Natural := 0;

   function Zero return Natural is
   begin
      return N;
   end Zero;

begin
   N := Zero;
   N := N - 1;
end GnatMP;

compiled with switches -gnatp -gnat-p and run generates the
following output:

raised CONSTRAINT_ERROR : gnatmp.adb:11 range check failed

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

2010-06-16  Robert Dewar  <dewar@adacore.com>

	* back_end.adb (Switch_Subsequently_Cancelled): New function
	Move declarations to package body level to support this change
	* back_end.ads (Switch_Subsequently_Cancelled): New function
	* gnat_ugn.texi: Document -gnat-p switch
	* switch-c.adb (Scan_Front_End_Switches): Implement -gnat-p switch
	* ug_words: Add entry for -gnat-p (UNSUPPRESS_ALL)
	* usage.adb: Add line for -gnat-p switch
	* vms_data.ads: Add entry for UNSUPPRESS_ALL (-gnat-p)
diff mbox

Patch

Index: switch-c.adb
===================================================================
--- switch-c.adb	(revision 160834)
+++ switch-c.adb	(working copy)
@@ -23,6 +23,7 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Back_End; use Back_End;
 with Debug;    use Debug;
 with Lib;      use Lib;
 with Osint;    use Osint;
@@ -662,20 +663,27 @@  package body Switch.C is
             when 'p' =>
                Ptr := Ptr + 1;
 
-               --  Set all specific options as well as All_Checks in the
-               --  Suppress_Options array, excluding Elaboration_Check, since
-               --  this is treated specially because we do not want -gnatp to
-               --  disable static elaboration processing.
-
-               for J in Suppress_Options'Range loop
-                  if J /= Elaboration_Check then
-                     Suppress_Options (J) := True;
-                  end if;
-               end loop;
+               --  Skip processing if cancelled by subsequent -gnat-p
+
+               if Switch_Subsequently_Cancelled ("p") then
+                  Store_Switch := False;
 
-               Validity_Checks_On         := False;
-               Opt.Suppress_Checks        := True;
-               Opt.Enable_Overflow_Checks := False;
+               else
+                  --  Set all specific options as well as All_Checks in the
+                  --  Suppress_Options array, excluding Elaboration_Check,
+                  --  since this is treated specially because we do not want
+                  --  -gnatp to disable static elaboration processing.
+
+                  for J in Suppress_Options'Range loop
+                     if J /= Elaboration_Check then
+                        Suppress_Options (J) := True;
+                     end if;
+                  end loop;
+
+                  Validity_Checks_On         := False;
+                  Opt.Suppress_Checks        := True;
+                  Opt.Enable_Overflow_Checks := False;
+               end if;
 
             --  Processing for P switch
 
@@ -933,6 +941,7 @@  package body Switch.C is
             --  Processing for z switch
 
             when 'z' =>
+
                --  -gnatz must be the first and only switch in Switch_Chars,
                --  and is a two-letter switch.
 
@@ -1027,10 +1036,31 @@  package body Switch.C is
                   Ada_Version_Explicit := Ada_Version;
                end if;
 
-            --  Ignore extra switch character
+            --  Switch cancellation, currently only -gnat-p is allowed.
+            --  All we do here is the error checking, since the actual
+            --  processing for switch cancellation is done by calls to
+            --  Switch_Subsequently_Cancelled at the appropriate point.
 
-            when '/' | '-' =>
-               Ptr := Ptr + 1;
+            when '-' =>
+
+               --  Simple ignore -gnat-p
+
+               if Switch_Chars = "-gnat-p" then
+                  return;
+
+               --  Any other occurrence of minus is ignored. This is for
+               --  maximum compatibility with previous version which ignored
+               --  all occurrences of minus.
+
+               else
+                  Store_Switch := False;
+                  Ptr := Ptr + 1;
+               end if;
+
+            --  We ignore '/' in switches, this is historical, still needed???
+
+            when '/' =>
+               Store_Switch := False;
 
             --  Anything else is an error (illegal switch character)
 
Index: usage.adb
===================================================================
--- usage.adb	(revision 160834)
+++ usage.adb	(working copy)
@@ -598,4 +598,9 @@  begin
       Write_Line ("Allow Ada 2005 extensions");
    end if;
 
+   --  Line for -gnat-p switch
+
+   Write_Switch_Char ("-p");
+   Write_Line ("Cancel effect of previous -gnatp switch");
+
 end Usage;
Index: ug_words
===================================================================
--- ug_words	(revision 160834)
+++ ug_words	(working copy)
@@ -85,6 +85,7 @@  gcc -c          ^ GNAT COMPILE
 -gnatN          ^ /INLINE=FULL
 -gnato          ^ /CHECKS=OVERFLOW
 -gnatp          ^ /CHECKS=SUPPRESS_ALL
+-gnat-p         ^ /CHECKS=UNSUPPRESS_ALL
 -gnatP          ^ /POLLING
 -gnatR          ^ /REPRESENTATION_INFO
 -gnatR0         ^ /REPRESENTATION_INFO=NONE
Index: gnat_ugn.texi
===================================================================
--- gnat_ugn.texi	(revision 160834)
+++ gnat_ugn.texi	(working copy)
@@ -4294,7 +4294,12 @@  controlled by this switch (division by z
 
 @item -gnatp
 @cindex @option{-gnatp} (@command{gcc})
-Suppress all checks. See @ref{Run-Time Checks} for details.
+Suppress all checks. See @ref{Run-Time Checks} for details. This switch
+has no effect if cancelled by a subsequent @option{-gnat-p} switch.
+
+@item -gnat-p
+@cindex @option{-gnat-p} (@command{gcc})
+Cancel effect of previous @option{-gnatp} switch.
 
 @item -gnatP
 @cindex @option{-gnatP} (@command{gcc})
@@ -4591,6 +4596,9 @@  The switches
 @option{-gnatzc} and @option{-gnatzr} may not be combined with any other
 switches, and only one of them may appear in the command line.
 
+@item
+The switch @option{-gnat-p} may not be combined with any other switch.
+
 @ifclear vms
 @item
 Once a ``y'' appears in the string (that is a use of the @option{-gnaty}
@@ -6622,6 +6630,16 @@  year). The compiler will generate code b
 the condition being checked is true, which can result in disaster if
 that assumption is wrong.
 
+The @option{-gnatp} switch has no effect if a subsequent
+@option{-gnat-p} switch appears.
+
+@item -gnat-p
+@cindex @option{-gnat-p} (@command{gcc})
+@cindex Suppressing checks
+@cindex Checks, suppressing
+@findex Suppress
+This switch cancels the effect of a previous @option{gnatp} switch.
+
 @item -gnato
 @cindex @option{-gnato} (@command{gcc})
 @cindex Overflow checks
Index: back_end.adb
===================================================================
--- back_end.adb	(revision 160834)
+++ back_end.adb	(working copy)
@@ -42,6 +42,29 @@  with Types;     use Types;
 
 package body Back_End is
 
+   type Arg_Array is array (Nat) of Big_String_Ptr;
+   type Arg_Array_Ptr is access Arg_Array;
+   --  Types to access compiler arguments
+
+   Next_Arg : Pos := 1;
+   --  Next argument to be scanned by Scan_Compiler_Arguments. We make this
+   --  global so that it can be accessed by Switch_Subsequently_Cancelled.
+
+   flag_stack_check : Int;
+   pragma Import (C, flag_stack_check);
+   --  Indicates if stack checking is enabled, imported from toplev.c
+
+   save_argc : Nat;
+   pragma Import (C, save_argc);
+   --  Saved value of argc (number of arguments), imported from toplev.c
+
+   save_argv : Arg_Array_Ptr;
+   pragma Import (C, save_argv);
+   --  Saved value of argv (argument pointers), imported from toplev.c
+
+   function Len_Arg (Arg : Pos) return Nat;
+   --  Determine length of argument number Arg on original gnat1 command line
+
    -------------------
    -- Call_Back_End --
    -------------------
@@ -122,37 +145,30 @@  package body Back_End is
          gigi_operating_mode           => Mode);
    end Call_Back_End;
 
+   -------------
+   -- Len_Arg --
+   -------------
+
+   function Len_Arg (Arg : Pos) return Nat is
+   begin
+      for J in 1 .. Nat'Last loop
+         if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
+            return J - 1;
+         end if;
+      end loop;
+
+      raise Program_Error;
+   end Len_Arg;
+
    -----------------------------
    -- Scan_Compiler_Arguments --
    -----------------------------
 
    procedure Scan_Compiler_Arguments is
-      Next_Arg : Pos := 1;
-
-      type Arg_Array is array (Nat) of Big_String_Ptr;
-      type Arg_Array_Ptr is access Arg_Array;
-
-      flag_stack_check : Int;
-      pragma Import (C, flag_stack_check);
-      --  Import from toplev.c
-
-      save_argc : Nat;
-      pragma Import (C, save_argc);
-      --  Import from toplev.c
-
-      save_argv : Arg_Array_Ptr;
-      pragma Import (C, save_argv);
-      --  Import from toplev.c
 
       Output_File_Name_Seen : Boolean := False;
       --  Set to True after having scanned file_name for switch "-gnatO file"
 
-      --  Local functions
-
-      function Len_Arg (Arg : Pos) return Nat;
-      --  Determine length of argument number Arg on the original command line
-      --  from gnat1.
-
       procedure Scan_Back_End_Switches (Switch_Chars : String);
       --  Procedure to scan out switches stored in Switch_Chars. The first
       --  character is known to be a valid switch character, and there are no
@@ -165,21 +181,6 @@  package body Back_End is
       --  switches must still be scanned to skip "-o" or internal GCC switches
       --  with their argument.
 
-      -------------
-      -- Len_Arg --
-      -------------
-
-      function Len_Arg (Arg : Pos) return Nat is
-      begin
-         for J in 1 .. Nat'Last loop
-            if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
-               return J - 1;
-            end if;
-         end loop;
-
-         raise Program_Error;
-      end Len_Arg;
-
       ----------------------------
       -- Scan_Back_End_Switches --
       ----------------------------
@@ -296,4 +297,31 @@  package body Back_End is
       end loop;
    end Scan_Compiler_Arguments;
 
+   -----------------------------------
+   -- Switch_Subsequently_Cancelled --
+   -----------------------------------
+
+   function Switch_Subsequently_Cancelled (C : String) return Boolean is
+      Arg : Pos;
+
+   begin
+      Arg := Next_Arg + 1;
+      while Arg < save_argc loop
+         declare
+            Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
+            Argv_Len : constant Nat            := Len_Arg (Arg);
+            Argv     : constant String         :=
+                         Argv_Ptr (1 .. Natural (Argv_Len));
+         begin
+            if Argv = "-gnat-" & C then
+               return True;
+            end if;
+         end;
+
+         Arg := Arg + 1;
+      end loop;
+
+      return False;
+   end Switch_Subsequently_Cancelled;
+
 end Back_End;
Index: back_end.ads
===================================================================
--- back_end.ads	(revision 160834)
+++ back_end.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -61,4 +61,11 @@  package Back_End is
    --  Any processed switches that influence the result of a compilation must
    --  be added to the Compilation_Arguments table.
 
+   function Switch_Subsequently_Cancelled (C : String) return Boolean;
+   --  This function is called from Scan_Front_End_Switches. It determines if
+   --  the switch currently being scanned is followed by a switch of the form
+   --  "-gnat-" & C, where C is the argument. If so, then True is returned,
+   --  and Scan_Front_End_Switches will cancel the effect of the switch. If
+   --  no such switch is found, False is returned.
+
 end Back_End;
Index: vms_data.ads
===================================================================
--- vms_data.ads	(revision 160834)
+++ vms_data.ads	(working copy)
@@ -1253,7 +1253,9 @@  package VMS_Data is
                                              "STACK "                      &
                                                 "-fstack-check "           &
                                              "SUPPRESS_ALL "               &
-                                                "-gnatp";
+                                                "-gnatp "                  &
+                                             "UNSUPPRESS_ALL "             &
+                                                "-gnat-p";
    --        /NOCHECKS
    --        /CHECKS[=(keyword[,...])]
    --
@@ -1267,47 +1269,50 @@  package VMS_Data is
    --   You may specify one or more of the following keywords to the /CHECKS
    --   qualifier to modify this behavior:
    --
-   --     DEFAULT       The behavior described above. This is the default
-   --                   if the /CHECKS qualifier is not present on the
-   --                   command line. Same as /NOCHECKS.
-   --
-   --     OVERFLOW      Enables overflow checking for integer operations and
-   --                   checks for access before elaboration on subprogram
-   --                   calls. This causes GNAT to generate slower and larger
-   --                   executable programs by adding code to check for both
-   --                   overflow and division by zero (resulting in raising
-   --                   "Constraint_Error" as required by Ada semantics).
-   --                   Similarly, GNAT does not generate elaboration check
-   --                   by default, and you must specify this keyword to
-   --                   enable them.
-   --
-   --                   Note that this keyword does not affect the code
-   --                   generated for any floating-point operations; it
-   --                   applies only to integer operations. For floating-point,
-   --                   GNAT has the "Machine_Overflows" attribute set to
-   --                   "False" and the normal mode of operation is to generate
-   --                   IEEE NaN and infinite values on overflow or invalid
-   --                   operations (such as dividing 0.0 by 0.0).
-   --
-   --     ELABORATION   Enables dynamic checks for access-before-elaboration
-   --                   on subprogram calls and generic instantiations.
-   --
-   --     ASSERTIONS    The pragmas "Assert" and "Debug" normally have no
-   --                   effect and are ignored. This keyword causes "Assert"
-   --                   and "Debug" pragmas to be activated, as well as
-   --                   "Check", "Precondition" and "Postcondition" pragmas.
-   --
-   --     SUPPRESS_ALL  Suppress all runtime checks as though you have "pragma
-   --                   Suppress (all_checks)" in your source. Use this switch
-   --                   to improve the performance of the code at the expense
-   --                   of safety in the presence of invalid data or program
-   --                   bugs.
+   --     DEFAULT          The behavior described above. This is the default
+   --                      if the /CHECKS qualifier is not present on the
+   --                      command line. Same as /NOCHECKS.
+   --
+   --     OVERFLOW        Enables overflow checking for integer operations and
+   --                     checks for access before elaboration on subprogram
+   --                     calls. This causes GNAT to generate slower and larger
+   --                     executable programs by adding code to check for both
+   --                     overflow and division by zero (resulting in raising
+   --                     "Constraint_Error" as required by Ada semantics).
+   --                     Similarly, GNAT does not generate elaboration check
+   --                     by default, and you must specify this keyword to
+   --                     enable them.
+   --
+   --                     Note that this keyword does not affect the code
+   --                     generated for any floating-point operations; it
+   --                     applies only to integer operations. For the case of
+   --                     floating-point, GNAT has the "Machine_Overflows"
+   --                     attribute set to "False" and the normal mode of
+   --                     operation is to generate IEEE NaN and infinite values
+   --                     on overflow or invalid operations (such as dividing
+   --                     0.0 by 0.0).
+   --
+   --     ELABORATION     Enables dynamic checks for access-before-elaboration
+   --                     on subprogram calls and generic instantiations.
+   --
+   --     ASSERTIONS      The pragmas "Assert" and "Debug" normally have no
+   --                     effect and are ignored. This keyword causes "Assert"
+   --                     and "Debug" pragmas to be activated, as well as
+   --                     "Check", "Precondition" and "Postcondition" pragmas.
+   --
+   --     SUPPRESS_ALL    Suppress all runtime checks as though you have
+   --                     "pragma Suppress (all_checks)" in your source. Use
+   --                     this switch to improve the performance of the code at
+   --                     the expense of safety in the presence of invalid data
+   --                     or program bugs.
    --
-   --     DEFAULT       Suppress the effect of any option OVERFLOW or
-   --                   ASSERTIONS.
+   --     UNSUPPRESS_ALL  Cancels effect of previous SUPPRESS_ALL.
    --
-   --     FULL (D)      Similar to OVERFLOW, but suppress the effect of any
-   --                   option ELABORATION or SUPPRESS_ALL.
+   --     DEFAULT         Suppress the effect of any option OVERFLOW or
+   --                     ASSERTIONS.
+   --
+   --     FULL (D)        Similar to OVERFLOW, but suppress the effect of any
+   --                     option ELABORATION or SUPPRESS_ALL.
    --
    --   These keywords only control the default setting of the checks.  You
    --   may modify them using either "Suppress" (to remove checks) or