+2010-06-16 Javier Miranda <miranda@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * sem_ch5.adb (Analyze_Exit_Statement): Return if no enclosing loop,
+ to prevent cascaded errors and compilation aborts.
+
+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)
+
+2010-06-16 Robert Dewar <dewar@adacore.com>
+
+ * sem_warn.adb (Check_Infinite_Loop_Warning): Declaration counts as
+ modification.
+
+2010-06-16 Robert Dewar <dewar@adacore.com>
+
+ * exp_disp.adb: Minor reformatting
+
2010-06-16 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): Inherit class_wide type from
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 --
-------------------
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
-- 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 --
----------------------------
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;
-- --
-- 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- --
-- 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;
-- 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,
@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})
@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}
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
else
Error_Msg_N
("cannot exit from program unit or accept statement", N);
- exit;
+ return;
end if;
end loop;
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
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;
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;
-- --
------------------------------------------------------------------------------
+with Back_End; use Back_End;
with Debug; use Debug;
with Lib; use Lib;
with Osint; use Osint;
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
-- Processing for z switch
when 'z' =>
+
-- -gnatz must be the first and only switch in Switch_Chars,
-- and is a two-letter switch.
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)
-gnatN ^ /INLINE=FULL
-gnato ^ /CHECKS=OVERFLOW
-gnatp ^ /CHECKS=SUPPRESS_ALL
+-gnat-p ^ /CHECKS=UNSUPPRESS_ALL
-gnatP ^ /POLLING
-gnatR ^ /REPRESENTATION_INFO
-gnatR0 ^ /REPRESENTATION_INFO=NONE
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;
"STACK " &
"-fstack-check " &
"SUPPRESS_ALL " &
- "-gnatp";
+ "-gnatp " &
+ "UNSUPPRESS_ALL " &
+ "-gnat-p";
-- /NOCHECKS
-- /CHECKS[=(keyword[,...])]
--
-- 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
OSDN Git Service
