From patchwork Wed Jun 16 16:25:28 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 55911 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 38A59B7D81 for ; Thu, 17 Jun 2010 02:25:36 +1000 (EST) Received: (qmail 24107 invoked by alias); 16 Jun 2010 16:25:33 -0000 Received: (qmail 24011 invoked by uid 22791); 16 Jun 2010 16:25:28 -0000 X-SWARE-Spam-Status: No, hits=-0.9 required=5.0 tests=AWL, BAYES_40, TW_RG, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 16 Jun 2010 16:25:15 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 1410CCB0246; Wed, 16 Jun 2010 18:25:19 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id F9zNH9EvfV9x; Wed, 16 Jun 2010 18:25:19 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id F3AE1CB01E2; Wed, 16 Jun 2010 18:25:18 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id DB048D9B31; Wed, 16 Jun 2010 18:25:28 +0200 (CEST) Date: Wed, 16 Jun 2010 18:25:28 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Implement -gnat-p switch (cancel previous -gnatp) Message-ID: <20100616162528.GA27707@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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) 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