[multiple changes]

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.

From-SVN: r160847

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  <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
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