From 3f165ff29a1aec939b43a498b1899b21bc50366b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 16 Jun 2010 18:22:44 +0200 Subject: [multiple changes] 2010-06-16 Javier Miranda * exp_disp.adb (Expand_Dispatching_Call): Adjust the decoration of the node referenced by the SCIL node of dispatching "=" to skip the tags comparison. 2010-06-16 Ed Schonberg * sem_ch5.adb (Analyze_Exit_Statement): Return if no enclosing loop, to prevent cascaded errors and compilation aborts. 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) 2010-06-16 Robert Dewar * sem_warn.adb (Check_Infinite_Loop_Warning): Declaration counts as modification. From-SVN: r160847 --- gcc/ada/ChangeLog | 31 +++++++++++++++ gcc/ada/back_end.adb | 102 ++++++++++++++++++++++++++++++++------------------ gcc/ada/back_end.ads | 9 ++++- gcc/ada/exp_disp.adb | 9 +++++ gcc/ada/gnat_ugn.texi | 20 +++++++++- gcc/ada/sem_ch5.adb | 2 +- gcc/ada/sem_warn.adb | 47 +++++++++++++---------- gcc/ada/switch-c.adb | 60 +++++++++++++++++++++-------- gcc/ada/ug_words | 1 + gcc/ada/usage.adb | 5 +++ gcc/ada/vms_data.ads | 89 ++++++++++++++++++++++--------------------- 11 files changed, 258 insertions(+), 117 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a5e8ab6..83f82c6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2010-06-16 Javier Miranda + + * exp_disp.adb (Expand_Dispatching_Call): Adjust the decoration of the + node referenced by the SCIL node of dispatching "=" to skip the tags + comparison. + +2010-06-16 Ed Schonberg + + * sem_ch5.adb (Analyze_Exit_Statement): Return if no enclosing loop, + to prevent cascaded errors and compilation aborts. + +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) + +2010-06-16 Robert Dewar + + * sem_warn.adb (Check_Infinite_Loop_Warning): Declaration counts as + modification. + +2010-06-16 Robert Dewar + + * exp_disp.adb: Minor reformatting + 2010-06-16 Ed Schonberg * sem_ch3.adb (Complete_Private_Subtype): Inherit class_wide type from diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index f23a320..47836cb 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -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; diff --git a/gcc/ada/back_end.ads b/gcc/ada/back_end.ads index 19144a1..a9108f5 100644 --- a/gcc/ada/back_end.ads +++ b/gcc/ada/back_end.ads @@ -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; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index e7f980c..72127e1 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -922,6 +922,15 @@ package body Exp_Disp is -- we generate: x.tag = y.tag and then x = y if Subp = Eq_Prim_Op then + + -- Adjust the node referenced by the SCIL node to skip the tags + -- comparison because it is the information needed by the SCIL + -- backend to process this dispatching call + + if Generate_SCIL then + Set_SCIL_Related_Node (SCIL_Node, New_Call); + end if; + Param := First_Actual (Call_Node); New_Call := Make_And_Then (Loc, diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 7ea2454..3fee1ba 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4294,7 +4294,12 @@ controlled by this switch (division by zero checking is on by default). @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 based on the assumption that 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 diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 44909e2..57bd1b4 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1198,7 +1198,7 @@ package body Sem_Ch5 is else Error_Msg_N ("cannot exit from program unit or accept statement", N); - exit; + return; end if; end loop; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 841f5dd..7a5414f 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -538,6 +538,13 @@ package body Sem_Warn is then return Abandon; end if; + + -- Declaration of the variable in question + + elsif Nkind (N) = N_Object_Declaration + and then Defining_Identifier (N) = Var + then + return Abandon; end if; -- All OK, continue scan @@ -554,24 +561,34 @@ package body Sem_Warn is return; end if; - -- Case of WHILE loop + -- Deal with Iteration scheme present declare Iter : constant Node_Id := Iteration_Scheme (Loop_Statement); begin - if Present (Iter) and then Present (Condition (Iter)) then + if Present (Iter) then - -- Skip processing for while iteration with conditions actions, - -- since they make it too complicated to get the warning right. + -- While iteration - if Present (Condition_Actions (Iter)) then - return; - end if; + if Present (Condition (Iter)) then + + -- Skip processing for while iteration with conditions actions, + -- since they make it too complicated to get the warning right. - -- Capture WHILE condition + if Present (Condition_Actions (Iter)) then + return; + end if; - Expression := Condition (Iter); + -- Capture WHILE condition + + Expression := Condition (Iter); + + -- For iteration, do not process, since loop will always terminate + + elsif Present (Loop_Parameter_Specification (Iter)) then + return; + end if; end if; end; @@ -3490,26 +3507,16 @@ package body Sem_Warn is and then Is_Known_Branch then declare - Start : Source_Ptr; - Dummy : Source_Ptr; - Typ : Character; Atrue : Boolean; begin - Sloc_Range (Orig, Start, Dummy); Atrue := Test_Result; if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not then Atrue := not Atrue; end if; - if Atrue then - Typ := 't'; - else - Typ := 'f'; - end if; - - Set_SCO_Condition (Start, Typ); + Set_SCO_Condition (Orig, Atrue); end; end if; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 7b19410..8beaec8 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -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. + -- Skip processing if cancelled by subsequent -gnat-p - for J in Suppress_Options'Range loop - if J /= Elaboration_Check then - Suppress_Options (J) := True; - end if; - end loop; + if Switch_Subsequently_Cancelled ("p") then + Store_Switch := 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; + 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) diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 5e168d2..efa5356 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -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 diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 9e2b3c4..87d2735 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -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; diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index d25f7a3..7a87c4a 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -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 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. + -- 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. + -- + -- UNSUPPRESS_ALL Cancels effect of previous 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 -- cgit v1.1