2005-11-14 Robert Dewar <dewar@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>

	PR ada/18434

	* types.ads: Include All_Checks in Suppress_Array

	* checks.adb (Check_Needed): Remove kludge for a/=b rewritten as
	not(a=b), since we no longer do this rewriting, and hence it is not
	needed.
	(Elaboration_Checks_Suppressed): Add special casing to
	deal with different cases of static and dynamic elaboration checks (all
	checks does not count in the first case, but does in the second).
	(Expr_Known_Valid): Do not assume that the result of any arbitrary
	function call is valid, since this is not the case.
	(Ensure_Valid): Do not apply validity check to a real literal
	in a universal or fixed context

	* exp_ch4.adb (Expand_N_Op_Ne): Don't expand a/=b to not(a=b) for
	elementary types using the operator in standard. It is cleaner not to
	modify the programmers intent, especially in the case of floating-point.
	(Rewrite_Comparison): Fix handling of /= (this was always wrong, but
	it did not matter because we always rewrote a/=b to not(a=b).
	(Expand_Allocator_Expression): For an allocator expression whose nominal
	subtype is an unconstrained packed type, convert the expression to its
	actual constrained subtype.
	Implement warning for <= or >= where < or > not possible
	Fix to Vax_Float tests (too early in many routines, causing premature
	Vax_Float expansions.

	* sem_prag.adb (Analyze_Pragma, case Obsolescent): Allow this pragma
	to be used with packages and generic packages as well as with
	subprograms.
	(Suppress): Set All_Checks, but not Elaboration_Check, for case
	of pragma Suppress (All_Checks)
	(Analyze_Pragma, case Warnings): Implement first argument allowed to be
	a string literal for precise control over warnings.
	Avoid raise of pragma in case of unrecognized pragma and just return
	instead.

	* sem_prag.ads: Minor reformatting

	* switch-c.adb (Scan_Front_End_Switches): Replace "raise Bad_Switch;"
	with call to new procedure Bad_Switch. Call Scan_Pos with new parameter
	Switch. Do not handle any exception.
	Include -gnatwx as part of -gnatg (warn on redundant parens)
	Allow optional = after -gnatm
	(Scan_Front_End_Switches): The -gnatp switch sets All_Checks, but no
	longer sets Elaboration_Checks.
	Code to set warning mode moved to Sem_Warn
	so that it can be shared by pragma processing.

	* s-mastop-tru64.adb (Pop_Frame): Remove redundant parentheses in if
	statement.

	* s-taprop-solaris.adb: 
	Change some <= to =, to avoid new warning

	* a-exexda.adb, prj-proc.adb: 
	Fix obvious typo (Num_Tracebacks compared <= 0 instead of < 0)
	Fix obvious typo (Total_Errors_Detected <= 0 should be = 0)


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106950 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 475 insertions, 439 deletions

diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb
index 6049ccd3285..6b3b802d117 100644
--- a/gcc/ada/a-exexda.adb
+++ b/gcc/ada/a-exexda.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -386,7 +386,7 @@ package body Exception_Data is
       Ptr  : in out Natural)
    is
    begin
-      if X.Num_Tracebacks <= 0 then
+      if X.Num_Tracebacks = 0 then
          return;
       end if;
 
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 8bb91714202..d53dcc07d8f 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -2481,13 +2481,11 @@ package body Checks is
             exit when N = Right_Opnd (P)
               and then Nkind (Left_Opnd (P)) = N_Op_Eq;
 
-         --  And/And then case, left operand must be inequality test. Note that
-         --  at this stage, the expander will have changed a/=b to not (a=b).
+         --  And/And then case, left operand must be inequality test
 
          elsif K = N_Op_And or else K = N_And_Then then
             exit when N = Right_Opnd (P)
-              and then Nkind (Left_Opnd (P)) = N_Op_Not
-              and then Nkind (Right_Opnd (Left_Opnd (P))) = N_Op_Eq;
+              and then Nkind (Left_Opnd (P)) = N_Op_Ne;
          end if;
 
          N := P;
@@ -3259,15 +3257,32 @@ package body Checks is
 
    function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean is
    begin
+      --  The complication in this routine is that if we are in the dynamic
+      --  model of elaboration, we also check All_Checks, since All_Checks
+      --  does not set Elaboration_Check explicitly.
+
       if Present (E) then
          if Kill_Elaboration_Checks (E) then
             return True;
+
          elsif Checks_May_Be_Suppressed (E) then
-            return Is_Check_Suppressed (E, Elaboration_Check);
+            if Is_Check_Suppressed (E, Elaboration_Check) then
+               return True;
+            elsif Dynamic_Elaboration_Checks then
+               return Is_Check_Suppressed (E, All_Checks);
+            else
+               return False;
+            end if;
          end if;
       end if;
 
-      return Scope_Suppress (Elaboration_Check);
+      if Scope_Suppress (Elaboration_Check) then
+         return True;
+      elsif Dynamic_Elaboration_Checks then
+         return Scope_Suppress (All_Checks);
+      else
+         return False;
+      end if;
    end Elaboration_Checks_Suppressed;
 
    ---------------------------
@@ -3690,6 +3705,15 @@ package body Checks is
       then
          return;
 
+      --  No check on a univeral real constant. The context will eventually
+      --  convert it to a machine number for some target type, or report an
+      --  illegality.
+
+      elsif Nkind (Expr) = N_Real_Literal
+        and then Etype (Expr) = Universal_Real
+      then
+         return;
+
       --  An annoying special case. If this is an out parameter of a scalar
       --  type, then the value is not going to be accessed, therefore it is
       --  inappropriate to do any validity check at the call site.
@@ -3845,11 +3869,10 @@ package body Checks is
       then
          return Expr_Known_Valid (Expression (Expr));
 
-      --  The result of any function call or operator is always considered
-      --  valid, since we assume the necessary checks are done by the call.
-      --  For operators on floating-point operations, we must also check
-      --  when the operation is the right-hand side of an assignment, or
-      --  is an actual in a call.
+      --  The result of any operator is always considered valid, since we
+      --  assume the necessary checks are done by the operator. For operators
+      --  on floating-point operations, we must also check when the operation
+      --  is the right-hand side of an assignment, or is an actual in a call.
 
       elsif
         Nkind (Expr) in N_Binary_Op or else Nkind (Expr) in N_Unary_Op
@@ -3866,9 +3889,6 @@ package body Checks is
             return True;
          end if;
 
-      elsif Nkind (Expr) = N_Function_Call then
-         return True;
-
       --  For all other cases, we do not know the expression is valid
 
       else
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index fbdb701550a..2e1f38f88e4 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -38,6 +38,7 @@ with Exp_Pakd; use Exp_Pakd;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Exp_VFpt; use Exp_VFpt;
+with Freeze;   use Freeze;
 with Hostparm; use Hostparm;
 with Inline;   use Inline;
 with Nlists;   use Nlists;
@@ -361,14 +362,15 @@ package body Exp_Ch4 is
    ---------------------------------
 
    procedure Expand_Allocator_Expression (N : Node_Id) is
-      Loc   : constant Source_Ptr := Sloc (N);
-      Exp   : constant Node_Id    := Expression (Expression (N));
-      Indic : constant Node_Id    := Subtype_Mark (Expression (N));
-      PtrT  : constant Entity_Id  := Etype (N);
-      T     : constant Entity_Id  := Entity (Indic);
-      Flist : Node_Id;
-      Node  : Node_Id;
-      Temp  : Entity_Id;
+      Loc    : constant Source_Ptr := Sloc (N);
+      Exp    : constant Node_Id    := Expression (Expression (N));
+      Indic  : constant Node_Id    := Subtype_Mark (Expression (N));
+      PtrT   : constant Entity_Id  := Etype (N);
+      DesigT : constant Entity_Id  := Designated_Type (PtrT);
+      T      : constant Entity_Id  := Entity (Indic);
+      Flist  : Node_Id;
+      Node   : Node_Id;
+      Temp   : Entity_Id;
 
       Aggr_In_Place : constant Boolean := Is_Delayed_Aggregate (Exp);
 
@@ -456,7 +458,7 @@ package body Exp_Ch4 is
          --  body, so a run-time check is needed in general.
 
          if Ada_Version >= Ada_05
-           and then Is_Class_Wide_Type (Designated_Type (PtrT))
+           and then Is_Class_Wide_Type (DesigT)
            and then not Scope_Suppress (Accessibility_Check)
            and then
              (Is_Class_Wide_Type (Etype (Exp))
@@ -539,7 +541,7 @@ package body Exp_Ch4 is
             end;
          end if;
 
-         if Controlled_Type (Designated_Type (PtrT))
+         if Controlled_Type (DesigT)
             and then Controlled_Type (T)
          then
             declare
@@ -629,14 +631,14 @@ package body Exp_Ch4 is
          Rewrite (N, New_Reference_To (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
-      elsif Is_Access_Type (Designated_Type (PtrT))
+      elsif Is_Access_Type (DesigT)
         and then Nkind (Exp) = N_Allocator
         and then Nkind (Expression (Exp)) /= N_Qualified_Expression
       then
          --  Apply constraint to designated subtype indication
 
          Apply_Constraint_Check (Expression (Exp),
-           Designated_Type (Designated_Type (PtrT)),
+           Designated_Type (DesigT),
            No_Sliding => True);
 
          if Nkind (Expression (Exp)) = N_Raise_Constraint_Error then
@@ -663,12 +665,12 @@ package body Exp_Ch4 is
          --  on the qualified expression does not allow sliding,
          --  but this check does (a relaxation from Ada 83).
 
-         if Is_Constrained (Designated_Type (PtrT))
+         if Is_Constrained (DesigT)
            and then not Subtypes_Statically_Match
-                          (T, Designated_Type (PtrT))
+                          (T, DesigT)
          then
             Apply_Constraint_Check
-              (Exp, Designated_Type (PtrT), No_Sliding => False);
+              (Exp, DesigT, No_Sliding => False);
 
          --  The nonsliding check should really be performed
          --  (unconditionally) against the subtype of the
@@ -677,8 +679,33 @@ package body Exp_Ch4 is
 
          else
             Apply_Constraint_Check
-              (Exp, Designated_Type (PtrT), No_Sliding => True);
+              (Exp, DesigT, No_Sliding => True);
+         end if;
+
+         --  For an access to unconstrained packed array, GIGI needs
+         --  to see an expression with a constrained subtype in order
+         --  to compute the proper size for the allocator.
+
+         if Is_Array_Type (T)
+           and then not Is_Constrained (T)
+           and then Is_Packed (T)
+         then
+            declare
+               ConstrT      : constant Entity_Id :=
+                                Make_Defining_Identifier (Loc,
+                                  Chars => New_Internal_Name ('A'));
+               Internal_Exp : constant Node_Id   := Relocate_Node (Exp);
+            begin
+               Insert_Action (Exp,
+                 Make_Subtype_Declaration (Loc,
+                   Defining_Identifier => ConstrT,
+                   Subtype_Indication  =>
+                     Make_Subtype_From_Expr (Exp, T)));
+               Freeze_Itype (ConstrT, Exp);
+               Rewrite (Exp, OK_Convert_To (ConstrT, Internal_Exp));
+            end;
          end if;
+
       end if;
 
    exception
@@ -3854,13 +3881,6 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
-      --  Vax_Float is a special case
-
-      if Vax_Float (Typ) then
-         Expand_Vax_Arith (N);
-         return;
-      end if;
-
       --  N / 1 = N for integer types
 
       if Is_Integer_Type (Typ)
@@ -3951,7 +3971,7 @@ package body Exp_Ch4 is
 
          Analyze_And_Resolve (Left_Opnd (N), Universal_Real);
 
-      --  Non-fixed point cases, do zero divide and overflow checks
+      --  Non-fixed point cases, do integer zero divide and overflow checks
 
       elsif Is_Integer_Type (Typ) then
          Apply_Divide_Check (N);
@@ -3963,6 +3983,12 @@ package body Exp_Ch4 is
          then
             Error_Msg_CRT ("64-bit division", N);
          end if;
+
+      --  Deal with Vax_Float
+
+      elsif Vax_Float (Typ) then
+         Expand_Vax_Arith (N);
+         return;
       end if;
    end Expand_N_Op_Divide;
 
@@ -4023,7 +4049,7 @@ package body Exp_Ch4 is
             begin
                --  Per-object constrained selected components require special
                --  attention. If the enclosing scope of the component is an
-               --  Unchecked_Union, we can not reference its discriminants
+               --  Unchecked_Union, we cannot reference its discriminants
                --  directly. This is why we use the two extra parameters of
                --  the equality function of the enclosing Unchecked_Union.
 
@@ -4239,14 +4265,13 @@ package body Exp_Ch4 is
                return False;
             end if;
 
+            --  We only need to test one component
+
             declare
                Comp : Node_Id := First (Component_Items (Clist));
 
             begin
                while Present (Comp) loop
-
-                  --  One component is sufficent
-
                   if Component_Is_Unconstrained_UU (Comp) then
                      return True;
                   end if;
@@ -4324,9 +4349,10 @@ package body Exp_Ch4 is
 
       if Ekind (Typl) = E_Private_Type then
          Typl := Underlying_Type (Typl);
-
       elsif Ekind (Typl) = E_Private_Subtype then
          Typl := Underlying_Type (Base_Type (Typl));
+      else
+         null;
       end if;
 
       --  It may happen in error situations that the underlying type is not
@@ -4339,15 +4365,9 @@ package body Exp_Ch4 is
 
       Typl := Base_Type (Typl);
 
-      --  Vax float types
-
-      if Vax_Float (Typl) then
-         Expand_Vax_Comparison (N);
-         return;
-
       --  Boolean types (requiring handling of non-standard case)
 
-      elsif Is_Boolean_Type (Typl) then
+      if Is_Boolean_Type (Typl) then
          Adjust_Condition (Left_Opnd (N));
          Adjust_Condition (Right_Opnd (N));
          Set_Etype (N, Standard_Boolean);
@@ -4551,11 +4571,18 @@ package body Exp_Ch4 is
       end if;
 
       --  If we still have an equality comparison (i.e. it was not rewritten
-      --  in some way), then we can test if result is needed at compile time).
+      --  in some way), then we can test if result is known at compile time).
 
       if Nkind (N) = N_Op_Eq then
          Rewrite_Comparison (N);
       end if;
+
+      --  If we still have comparison for Vax_Float, process it
+
+      if Vax_Float (Typl) and then Nkind (N) in N_Op_Compare  then
+         Expand_Vax_Comparison (N);
+         return;
+      end if;
    end Expand_N_Op_Eq;
 
    -----------------------
@@ -4870,11 +4897,7 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
-      if Vax_Float (Typ1) then
-         Expand_Vax_Comparison (N);
-         return;
-
-      elsif Is_Array_Type (Typ1) then
+      if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
@@ -4887,6 +4910,13 @@ package body Exp_Ch4 is
       end if;
 
       Rewrite_Comparison (N);
+
+      --  If we still have comparison, and Vax_Float type, process it
+
+      if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+         Expand_Vax_Comparison (N);
+         return;
+      end if;
    end Expand_N_Op_Ge;
 
    --------------------
@@ -4902,11 +4932,7 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
-      if Vax_Float (Typ1) then
-         Expand_Vax_Comparison (N);
-         return;
-
-      elsif Is_Array_Type (Typ1) then
+      if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
@@ -4919,6 +4945,13 @@ package body Exp_Ch4 is
       end if;
 
       Rewrite_Comparison (N);
+
+      --  If we still have comparison, and Vax_Float type, process it
+
+      if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+         Expand_Vax_Comparison (N);
+         return;
+      end if;
    end Expand_N_Op_Gt;
 
    --------------------
@@ -4934,11 +4967,7 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
-      if Vax_Float (Typ1) then
-         Expand_Vax_Comparison (N);
-         return;
-
-      elsif Is_Array_Type (Typ1) then
+      if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
@@ -4951,6 +4980,13 @@ package body Exp_Ch4 is
       end if;
 
       Rewrite_Comparison (N);
+
+      --  If we still have comparison, and Vax_Float type, process it
+
+      if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+         Expand_Vax_Comparison (N);
+         return;
+      end if;
    end Expand_N_Op_Le;
 
    --------------------
@@ -4966,11 +5002,7 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
-      if Vax_Float (Typ1) then
-         Expand_Vax_Comparison (N);
-         return;
-
-      elsif Is_Array_Type (Typ1) then
+      if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
@@ -4983,6 +5015,13 @@ package body Exp_Ch4 is
       end if;
 
       Rewrite_Comparison (N);
+
+      --  If we still have comparison, and Vax_Float type, process it
+
+      if Vax_Float (Typ1) and then Nkind (N) in N_Op_Compare then
+         Expand_Vax_Comparison (N);
+         return;
+      end if;
    end Expand_N_Op_Lt;
 
    -----------------------
@@ -5187,13 +5226,6 @@ package body Exp_Ch4 is
          end if;
       end if;
 
-      --  Deal with VAX float case
-
-      if Vax_Float (Typ) then
-         Expand_Vax_Arith (N);
-         return;
-      end if;
-
       --  Convert x * 2 ** y to Shift_Left (x, y). Note that the fact that
       --  Is_Power_Of_2_For_Shift is set means that we know that our left
       --  operand is an integer, as required for this to work.
@@ -5304,6 +5336,12 @@ package body Exp_Ch4 is
 
       elsif Is_Signed_Integer_Type (Etype (N)) then
          Apply_Arithmetic_Overflow_Check (N);
+
+      --  Deal with VAX float case
+
+      elsif Vax_Float (Typ) then
+         Expand_Vax_Arith (N);
+         return;
       end if;
    end Expand_N_Op_Multiply;
 
@@ -5311,39 +5349,74 @@ package body Exp_Ch4 is
    -- Expand_N_Op_Ne --
    --------------------
 
-   --  Rewrite node as the negation of an equality operation, and reanalyze.
-   --  The equality to be used is defined in the same scope and has the same
-   --  signature. It must be set explicitly because in an instance it may not
-   --  have the same visibility as in the generic unit.
-
    procedure Expand_N_Op_Ne (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
-      Neg : Node_Id;
-      Ne  : constant Entity_Id := Entity (N);
+      Typ : constant Entity_Id := Etype (Left_Opnd (N));
 
    begin
-      Binary_Op_Validity_Checks (N);
+      --  Case of elementary type with standard operator
 
-      Neg :=
-        Make_Op_Not (Loc,
-          Right_Opnd =>
-            Make_Op_Eq (Loc,
-              Left_Opnd =>  Left_Opnd (N),
-              Right_Opnd => Right_Opnd (N)));
-      Set_Paren_Count (Right_Opnd (Neg), 1);
+      if Is_Elementary_Type (Typ)
+        and then Sloc (Entity (N)) = Standard_Location
+      then
+         Binary_Op_Validity_Checks (N);
 
-      if Scope (Ne) /= Standard_Standard then
-         Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
-      end if;
+         --  Boolean types (requiring handling of non-standard case)
 
-      --  For navigation purposes, the inequality is treated as an implicit
-      --  reference to the corresponding equality. Preserve the Comes_From_
-      --  source flag so that the proper Xref entry is generated.
+         if Is_Boolean_Type (Typ) then
+            Adjust_Condition (Left_Opnd (N));
+            Adjust_Condition (Right_Opnd (N));
+            Set_Etype (N, Standard_Boolean);
+            Adjust_Result_Type (N, Typ);
+         end if;
 
-      Preserve_Comes_From_Source (Neg, N);
-      Preserve_Comes_From_Source (Right_Opnd (Neg), N);
-      Rewrite (N, Neg);
-      Analyze_And_Resolve (N, Standard_Boolean);
+         Rewrite_Comparison (N);
+
+         --  If we still have comparison for Vax_Float, process it
+
+         if Vax_Float (Typ) and then Nkind (N) in N_Op_Compare  then
+            Expand_Vax_Comparison (N);
+            return;
+         end if;
+
+      --  For all cases other than elementary types, we rewrite node as the
+      --  negation of an equality operation, and reanalyze. The equality to be
+      --  used is defined in the same scope and has the same signature. This
+      --  signature must be set explicitly since in an instance it may not have
+      --  the same visibility as in the generic unit. This avoids duplicating
+      --  or factoring the complex code for record/array equality tests etc.
+
+      else
+         declare
+            Loc : constant Source_Ptr := Sloc (N);
+            Neg : Node_Id;
+            Ne  : constant Entity_Id := Entity (N);
+
+         begin
+            Binary_Op_Validity_Checks (N);
+
+            Neg :=
+              Make_Op_Not (Loc,
+                Right_Opnd =>
+                  Make_Op_Eq (Loc,
+                    Left_Opnd =>  Left_Opnd (N),
+                    Right_Opnd => Right_Opnd (N)));
+            Set_Paren_Count (Right_Opnd (Neg), 1);
+
+            if Scope (Ne) /= Standard_Standard then
+               Set_Entity (Right_Opnd (Neg), Corresponding_Equality (Ne));
+            end if;
+
+            --  For navigation purposes, the inequality is treated as an
+            --  implicit reference to the corresponding equality. Preserve the
+            --  Comes_From_ source flag so that the proper Xref entry is
+            --  generated.
+
+            Preserve_Comes_From_Source (Neg, N);
+            Preserve_Comes_From_Source (Right_Opnd (Neg), N);
+            Rewrite (N, Neg);
+            Analyze_And_Resolve (N, Standard_Boolean);
+         end;
+      end if;
    end Expand_N_Op_Ne;
 
    ---------------------
@@ -6480,8 +6553,8 @@ package body Exp_Ch4 is
          --  then we do not trust it to be in range (might be infinite)
 
          declare
-            S_Lo : constant Node_Id   := Type_Low_Bound (Xtyp);
-            S_Hi : constant Node_Id   := Type_High_Bound (Xtyp);
+            S_Lo : constant Node_Id := Type_Low_Bound (Xtyp);
+            S_Hi : constant Node_Id := Type_High_Bound (Xtyp);
 
          begin
             if (not Is_Floating_Point_Type (Xtyp)
@@ -6533,9 +6606,9 @@ package body Exp_Ch4 is
            (Subtype_Mark (Conv), New_Occurrence_Of (Btyp, Loc));
          Set_Etype (Conv, Btyp);
 
-         --  Enable overflow except in the case of integer to float
-         --  conversions, where it is never required, since we can
-         --  never have overflow in this case.
+         --  Enable overflow except for case of integer to float conversions,
+         --  where it is never required, since we can never have overflow in
+         --  this case.
 
          if not Is_Integer_Type (Etype (Operand)) then
             Enable_Overflow_Check (Conv);
@@ -6588,13 +6661,6 @@ package body Exp_Ch4 is
          return;
       end if;
 
-      --  Deal with Vax floating-point cases
-
-      if Vax_Float (Operand_Type) or else Vax_Float (Target_Type) then
-         Expand_Vax_Conversion (N);
-         return;
-      end if;
-
       --  Nothing to do if this is the second argument of read. This
       --  is a "backwards" conversion that will be handled by the
       --  specialized code in attribute processing.
@@ -6881,7 +6947,7 @@ package body Exp_Ch4 is
          --  this type with proper overflow checking, and so gigi is doing an
          --  approximation of what is required by doing floating-point compares
          --  with the end-point. But that can lose precision in some cases, and
-         --  give a wrong result. Converting the operand to Long_Long_Float is
+         --  give a wrong result. Converting the operand to Universal_Real is
          --  helpful, but still does not catch all cases with 64-bit integers
          --  on targets with only 64-bit floats ???
 
@@ -6889,11 +6955,11 @@ package body Exp_Ch4 is
             Rewrite (Operand,
               Make_Type_Conversion (Loc,
                 Subtype_Mark =>
-                  New_Occurrence_Of (Standard_Long_Long_Float, Loc),
+                  New_Occurrence_Of (Universal_Real, Loc),
                 Expression =>
                   Relocate_Node (Operand)));
 
-            Set_Etype (Operand, Standard_Long_Long_Float);
+            Set_Etype (Operand, Universal_Real);
             Enable_Range_Check (Operand);
             Set_Do_Range_Check (Expression (Operand), False);
          end if;
@@ -6986,11 +7052,6 @@ package body Exp_Ch4 is
 
       elsif Is_Floating_Point_Type (Target_Type) then
          Real_Range_Check;
-
-      --  The remaining cases require no front end processing
-
-      else
-         null;
       end if;
 
       --  At this stage, either the conversion node has been transformed
@@ -7065,6 +7126,16 @@ package body Exp_Ch4 is
             end if;
          end;
       end if;
+
+      --  Final step, if the result is a type conversion involving Vax_Float
+      --  types, then it is subject for further special processing.
+
+      if Nkind (N) = N_Type_Conversion
+        and then (Vax_Float (Operand_Type) or else Vax_Float (Target_Type))
+      then
+         Expand_Vax_Conversion (N);
+         return;
+      end if;
    end Expand_N_Type_Conversion;
 
    -----------------------------------
@@ -7803,7 +7874,6 @@ package body Exp_Ch4 is
               Statements => New_List (If_Stat)));
 
       return Func_Body;
-
    end Make_Array_Comparison_Op;
 
    ---------------------------
@@ -7960,6 +8030,18 @@ package body Exp_Ch4 is
             True_Result  := Res in Compare_GE;
             False_Result := Res = LT;
 
+            if Res = LE
+              and then Constant_Condition_Warnings
+              and then Comes_From_Source (Original_Node (N))
+              and then Nkind (Original_Node (N)) = N_Op_Ge
+              and then not In_Instance
+              and then not Warnings_Off (Etype (Left_Opnd (N)))
+              and then Is_Integer_Type (Etype (Left_Opnd (N)))
+            then
+               Error_Msg_N
+                 ("can never be greater than, could replace by ""'=""?", N);
+            end if;
+
          when N_Op_Gt =>
             True_Result  := Res = GT;
             False_Result := Res in Compare_LE;
@@ -7972,9 +8054,21 @@ package body Exp_Ch4 is
             True_Result  := Res in Compare_LE;
             False_Result := Res = GT;
 
+            if Res = GE
+              and then Constant_Condition_Warnings
+              and then Comes_From_Source (Original_Node (N))
+              and then Nkind (Original_Node (N)) = N_Op_Le
+              and then not In_Instance
+              and then not Warnings_Off (Etype (Left_Opnd (N)))
+              and then Is_Integer_Type (Etype (Left_Opnd (N)))
+            then
+               Error_Msg_N
+                 ("can never be less than, could replace by ""'=""?", N);
+            end if;
+
          when N_Op_Ne =>
-            True_Result  := Res = NE;
-            False_Result := Res = LT or else Res = GT or else Res = EQ;
+            True_Result  := Res = NE or else Res = GT or else Res = LT;
+            False_Result := Res = EQ;
       end case;
 
       if True_Result then
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index da23ec7b10c..f9b5619c5bc 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2001-2005, 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- --
@@ -1129,7 +1129,7 @@ package body Prj.Proc is
          end loop;
       end if;
 
-      Success := Total_Errors_Detected <= 0;
+      Success := Total_Errors_Detected = 0;
    end Process;
 
    -------------------------------
diff --git a/gcc/ada/s-mastop-tru64.adb b/gcc/ada/s-mastop-tru64.adb
index 1a7b9876924..ce379033a40 100644
--- a/gcc/ada/s-mastop-tru64.adb
+++ b/gcc/ada/s-mastop-tru64.adb
@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                         (Version for Alpha/Dec Unix)                     --
 --                                                                          --
---           Copyright (C) 1999-2005 Ada Core Technologies, Inc.            --
+--                     Copyright (C) 1999-2005, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -143,7 +143,7 @@ package body System.Machine_State_Operations is
       Prf : constant System.Address := exc_lookup_function (Get_Code_Loc (M));
 
    begin
-      if (Prf = System.Null_Address) then
+      if Prf = System.Null_Address then
          c_set_code_loc (M, 0);
       else
          exc_virtual_unwind (Prf, M);
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index 371f7411826..c9e1504779a 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -1382,7 +1382,7 @@ package body System.Task_Primitives.Operations is
    begin
       --  Check that caller is abort-deferred
 
-      if Self_ID.Deferral_Level <= 0 then
+      if Self_ID.Deferral_Level = 0 then
          return False;
       end if;
 
@@ -1419,7 +1419,7 @@ package body System.Task_Primitives.Operations is
 
       --  Check that caller is abort-deferred
 
-      if Self_ID.Deferral_Level <= 0 then
+      if Self_ID.Deferral_Level = 0 then
          return False;
       end if;
 
@@ -1498,7 +1498,7 @@ package body System.Task_Primitives.Operations is
    begin
       --  Check that caller is abort-deferred
 
-      if Self_ID.Deferral_Level <= 0 then
+      if Self_ID.Deferral_Level = 0 then
          return False;
       end if;
 
@@ -1617,7 +1617,7 @@ package body System.Task_Primitives.Operations is
 
       --  Check that caller is abort-deferred
 
-      if Self_ID.Deferral_Level <= 0 then
+      if Self_ID.Deferral_Level = 0 then
          return False;
       end if;
 
@@ -1646,7 +1646,7 @@ package body System.Task_Primitives.Operations is
    begin
       --  Check that caller is abort-deferred
 
-      if Self_ID.Deferral_Level <= 0 then
+      if Self_ID.Deferral_Level = 0 then
          return False;
       end if;
 
@@ -1833,7 +1833,7 @@ package body System.Task_Primitives.Operations is
 
       --  Check that caller is abort-deferred
 
-      if Self_ID.Deferral_Level <= 0 then
+      if Self_ID.Deferral_Level = 0 then
          return False;
       end if;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 29233a4f7ca..b06f117e158 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -64,6 +64,7 @@ with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
 with Sem_VFpt; use Sem_VFpt;
+with Sem_Warn; use Sem_Warn;
 with Stand;    use Stand;
 with Sinfo;    use Sinfo;
 with Sinfo.CN; use Sinfo.CN;
@@ -236,8 +237,9 @@ package body Sem_Prag is
 
       Pragma_Exit : exception;
       --  This exception is used to exit pragma processing completely. It
-      --  is used when an error is detected, and in other situations where
-      --  it is known that no further processing is required.
+      --  is used when an error is detected, and no further processing is
+      --  required. It is also used if an earlier error has left the tree
+      --  in a state where the pragma should not be processed.
 
       Arg_Count : Nat;
       --  Number of pragma argument associations
@@ -1331,15 +1333,12 @@ package body Sem_Prag is
 
                   Analyze (Expression (Arg1));
 
-                  if        Unit_Kind = N_Generic_Subprogram_Declaration
+                  if Unit_Kind = N_Generic_Subprogram_Declaration
                     or else Unit_Kind = N_Subprogram_Declaration
                   then
                      Unit_Name := Defining_Entity (Unit_Node);
 
-                  elsif     Unit_Kind = N_Function_Instantiation
-                    or else Unit_Kind = N_Package_Instantiation
-                    or else Unit_Kind = N_Procedure_Instantiation
-                  then
+                  elsif Unit_Kind in N_Generic_Instantiation then
                      Unit_Name := Defining_Entity (Unit_Node);
 
                   else
@@ -2141,7 +2140,7 @@ package body Sem_Prag is
            and then Ekind (E) /= E_Variable
            and then not
              (Is_Access_Type (E)
-              and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
+                and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
          then
             Error_Pragma_Arg
               ("second argument of pragma% must be subprogram (type)",
@@ -3784,9 +3783,21 @@ package body Sem_Prag is
             --  suppress check for any check id value.
 
             if C = All_Checks then
+
+               --  For All_Checks, we set all specific checks with the
+               --  exception of Elaboration_Check, which is handled specially
+               --  because of not wanting All_Checks to have the effect of
+               --  deactivating static elaboration order processing.
+
                for J in Scope_Suppress'Range loop
-                  Scope_Suppress (J) := Suppress_Case;
+                  if J /= Elaboration_Check then
+                     Scope_Suppress (J) := Suppress_Case;
+                  end if;
                end loop;
+
+            --  If not All_Checks, just set appropriate entry. Note that we
+            --  will set Elaboration_Check if this is explicitly specified.
+
             else
                Scope_Suppress (C) := Suppress_Case;
             end if;
@@ -4259,7 +4270,7 @@ package body Sem_Prag is
          if Warn_On_Unrecognized_Pragma then
             Error_Pragma ("unrecognized pragma%!?");
          else
-            raise Pragma_Exit;
+            return;
          end if;
       else
          Prag_Id := Get_Pragma_Id (Chars (N));
@@ -5885,7 +5896,7 @@ package body Sem_Prag is
                Error_Pragma ("pragma% must refer to a spec, not a body");
             else
                Set_Body_Required (Cunit_Node, True);
-               Set_Has_Pragma_Elaborate_Body     (Cunit_Ent);
+               Set_Has_Pragma_Elaborate_Body (Cunit_Ent);
 
                --  If we are in dynamic elaboration mode, then we suppress
                --  elaboration warnings for the unit, since it is definitely
@@ -5991,7 +6002,7 @@ package body Sem_Prag is
                 Present (Source_Location)
             then
                Error_Pragma
-                 ("parameter profile and source location can not " &
+                 ("parameter profile and source location cannot " &
                   "be used together in pragma%");
             end if;
 
@@ -8141,6 +8152,28 @@ package body Sem_Prag is
             S      : String_Id;
             Active : Boolean := True;
 
+            procedure Check_Obsolete_Subprogram;
+            --  Checks if Subp is a subprogram declaration node, and if so
+            --  replaces Subp by the defining entity of the subprogram. If not,
+            --  issues an error message
+
+            ------------------------------
+            -- Check_Obsolete_Subprogram--
+            ------------------------------
+
+            procedure Check_Obsolete_Subprogram is
+            begin
+               if Nkind (Subp) /= N_Subprogram_Declaration then
+                  Error_Pragma
+                    ("pragma% misplaced, must immediately " &
+                     "follow subprogram/package declaration");
+               else
+                  Subp := Defining_Entity (Subp);
+               end if;
+            end Check_Obsolete_Subprogram;
+
+         --  Start of processing for pragma Obsolescent
+
          begin
             GNAT_Pragma;
             Check_At_Most_N_Arguments (2);
@@ -8153,6 +8186,7 @@ package body Sem_Prag is
 
             if Present (Prev (N)) then
                Subp := Prev (N);
+               Check_Obsolete_Subprogram;
 
             --  Second possibility, stand alone subprogram declaration with the
             --  pragma immediately following the declaration.
@@ -8161,25 +8195,22 @@ package body Sem_Prag is
               and then Nkind (Parent (N)) = N_Compilation_Unit_Aux
             then
                Subp := Unit (Parent (Parent (N)));
+               Check_Obsolete_Subprogram;
 
-            --  Any other possibility is a misplacement
+            --  Only other possibility is library unit placement for package
 
             else
-               Subp := Empty;
-            end if;
-
-            --  Check correct placement
+               Subp := Find_Lib_Unit_Name;
 
-            if Nkind (Subp) /= N_Subprogram_Declaration then
-               Error_Pragma
-                 ("pragma% misplaced, must immediately " &
-                  "follow subprogram spec");
+               if Ekind (Subp) /= E_Package
+                 and then Ekind (Subp) /= E_Generic_Package
+               then
+                  Check_Obsolete_Subprogram;
+               end if;
             end if;
 
             --  If OK placement, acquire arguments
 
-            Subp := Defining_Entity (Subp);
-
             if Arg_Count >= 1 then
 
                --  Deal with static string argument
@@ -9907,8 +9938,7 @@ package body Sem_Prag is
                  ("pragma% requires separate spec and must come before body");
 
             elsif Rep_Item_Too_Early (E, N)
-                 or else
-               Rep_Item_Too_Late (E, N)
+              or else Rep_Item_Too_Late (E, N)
             then
                raise Pragma_Exit;
 
@@ -10346,16 +10376,58 @@ package body Sem_Prag is
          --------------
 
          --  pragma Warnings (On | Off, [LOCAL_NAME])
+         --  pragma Warnings (static_string_EXPRESSION);
 
          when Pragma_Warnings => Warnings : begin
             GNAT_Pragma;
             Check_At_Least_N_Arguments (1);
-            Check_At_Most_N_Arguments (2);
             Check_No_Identifiers;
 
-            --  One argument case was processed by parser in Par.Prag
+            --  One argument case
 
-            if Arg_Count /= 1 then
+            if Arg_Count = 1 then
+               declare
+                  Argx : constant Node_Id := Get_Pragma_Arg (Arg1);
+
+               begin
+                  --  On/Off one argument case was processed by parser
+
+                  if Nkind (Argx) = N_Identifier
+                    and then
+                      (Chars (Argx) = Name_On
+                         or else
+                       Chars (Argx) = Name_Off)
+                  then
+                     null;
+
+                  else
+                     Check_Arg_Is_Static_Expression (Arg1, Standard_String);
+
+                     declare
+                        Lit : constant Node_Id   := Expr_Value_S (Argx);
+                        Str : constant String_Id := Strval (Lit);
+                        C   : Char_Code;
+
+                     begin
+                        for J in 1 .. String_Length (Str) loop
+                           C := Get_String_Char (Str, J);
+
+                           if In_Character_Range (C)
+                             and then Set_Warning_Switch (Get_Character (C))
+                           then
+                              null;
+                           else
+                              Error_Pragma_Arg
+                                ("invalid warning switch character", Arg1);
+                           end if;
+                        end loop;
+                     end;
+                  end if;
+               end;
+
+            --  Two argument case
+
+            elsif Arg_Count /= 1 then
                Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
                Check_Arg_Count (2);
 
@@ -10372,7 +10444,7 @@ package body Sem_Prag is
                   --  is a conversion. Retrieve the real entity name.
 
                   if (In_Instance_Body
-                       or else In_Inlined_Body)
+                      or else In_Inlined_Body)
                     and then Nkind (E_Id) = N_Unchecked_Type_Conversion
                   then
                      E_Id := Expression (E_Id);
@@ -10390,8 +10462,8 @@ package body Sem_Prag is
                      return;
                   else
                      loop
-                        Set_Warnings_Off (E,
-                          (Chars (Expression (Arg1)) = Name_Off));
+                        Set_Warnings_Off
+                          (E, (Chars (Expression (Arg1)) = Name_Off));
 
                         if Is_Enumeration_Type (E) then
                            declare
@@ -10410,6 +10482,10 @@ package body Sem_Prag is
                      end loop;
                   end if;
                end;
+
+               --  More than two arguments
+            else
+               Check_At_Most_N_Arguments (2);
             end if;
          end Warnings;
 
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index b598fdf2ec2..ed2a9a06f7d 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -28,62 +28,62 @@
 --  (logically this processing belongs in chapter 4)
 
 with Types; use Types;
+
 package Sem_Prag is
 
    procedure Analyze_Pragma (N : Node_Id);
    --  Analyze procedure for pragma reference node N
 
    function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
-   --  N is a pragma appearing in a configuration pragma file. Most
-   --  such pragmas are analyzed when the file is read, before parsing
-   --  and analyzing the main unit. However, the analysis of certain
-   --  pragmas results in adding information to the compiled main unit,
-   --  and this cannot be done till the main unit is processed. Such
-   --  pragmas return True from this function and in Frontend pragmas
-   --  where Delay_Config_Pragma_Analyze is True have their analysis
-   --  delayed until after the main program is parsed and analyzed.
+   --  N is a pragma appearing in a configuration pragma file. Most such
+   --  pragmas are analyzed when the file is read, before parsing and analyzing
+   --  the main unit. However, the analysis of certain pragmas results in
+   --  adding information to the compiled main unit, and this cannot be done
+   --  till the main unit is processed. Such pragmas return True from this
+   --  function and in Frontend pragmas where Delay_Config_Pragma_Analyze is
+   --  True have their analysis delayed until after the main program is parsed
+   --  and analyzed.
 
    function Is_Non_Significant_Pragma_Reference (N : Node_Id) return Boolean;
    --  The node N is a node for an entity and the issue is whether the
-   --  occurrence is a reference for the purposes of giving warnings
-   --  about unreferenced variables. This function returns True if the
-   --  reference is not a reference from this point of view (e.g. the
-   --  occurrence in a pragma Pack) and False if it is a real reference
-   --  (e.g. the occcurrence in a pragma Export);
+   --  occurrence is a reference for the purposes of giving warnings about
+   --  unreferenced variables. This function returns True if the reference is
+   --  not a reference from this point of view (e.g. the occurrence in a pragma
+   --  Pack) and False if it is a real reference (e.g. the occcurrence in a
+   --  pragma Export);
 
    function Is_Pragma_String_Literal (Par : Node_Id) return Boolean;
-   --  Given an N_Pragma_Argument_Association node, Par, which has the form
-   --  of an operator symbol, determines whether or not it should be treated
-   --  as an string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol.
-   --  If True is returned, the argument is converted to a string literal. If
+   --  Given an N_Pragma_Argument_Association node, Par, which has the form of
+   --  an operator symbol, determines whether or not it should be treated as an
+   --  string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol. If
+   --  True is returned, the argument is converted to a string literal. If
    --  False is returned, then the argument is treated as an entity reference
    --  to the operator.
 
    function Is_Config_Static_String (Arg : Node_Id) return Boolean;
-   --  This is called for a configuration pragma that requires either a
-   --  string literal or a concatenation of string literals. We cannot
-   --  use normal static string processing because it is too early in
-   --  the case of the pragma appearing in a configuration pragmas file.
-   --  If Arg is of an appropriate form, then this call obtains the string
-   --  (doing any necessary concatenations) and places it in Name_Buffer,
-   --  setting Name_Len to its length, and then returns True. If it is
-   --  not of the correct form, then an appropriate error message is
-   --  posted, and False is returned.
+   --  This is called for a configuration pragma that requires either string
+   --  literal or a concatenation of string literals. We cannot use normal
+   --  static string processing because it is too early in the case of the
+   --  pragma appearing in a configuration pragmas file. If Arg is of an
+   --  appropriate form, then this call obtains the string (doing any necessary
+   --  concatenations) and places it in Name_Buffer, setting Name_Len to its
+   --  length, and then returns True. If it is not of the correct form, then an
+   --  appropriate error message is posted, and False is returned.
 
    procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-   --  Called at the start of processing compilation unit N to deal with
-   --  any special issues regarding pragmas. In particular, we have to
-   --  deal with Suppress_All at this stage, since it appears after the
-   --  unit instead of before.
+   --  Called at the start of processing compilation unit N to deal with any
+   --  special issues regarding pragmas. In particular, we have to deal with
+   --  Suppress_All at this stage, since it appears after the unit instead of
+   --  before.
 
    procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
-   --  This routine is used to set an encoded interface name. The node
-   --  S is an N_String_Literal node for the external name to be set, and
-   --  E is an entity whose Interface_Name field is to be set. In the
-   --  normal case where S contains a name that is a valid C identifier,
-   --  then S is simply set as the value of the Interface_Name. Otherwise
-   --  it is encoded. See the body for details of the encoding. This
-   --  encoding is only done on VMS systems, since it seems pretty silly,
-   --  but is needed to pass some dubious tests in the test suite.
+   --  This routine is used to set an encoded interface name. The node S is an
+   --  N_String_Literal node for the external name to be set, and E is an
+   --  entity whose Interface_Name field is to be set. In the normal case where
+   --  S contains a name that is a valid C identifier, then S is simply set as
+   --  the value of the Interface_Name. Otherwise it is encoded. See the body
+   --  for details of the encoding. This encoding is only done on VMS systems,
+   --  since it seems pretty silly, but is needed to pass some dubious tests in
+   --  the test suite.
 
 end Sem_Prag;
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index c89eb1bc0fb..fe7545edadf 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2001-2005, 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- --
@@ -32,6 +32,7 @@ with Osint;    use Osint;
 with Opt;      use Opt;
 with Prepcomp; use Prepcomp;
 with Validsw;  use Validsw;
+with Sem_Warn; use Sem_Warn;
 with Stylesw;  use Stylesw;
 
 with System.WCh_Con; use System.WCh_Con;
@@ -67,7 +68,7 @@ package body Switch.C is
       --  Skip past the initial character (must be the switch character)
 
       if Ptr = Max then
-         raise Bad_Switch;
+         Bad_Switch (C);
       else
          Ptr := Ptr + 1;
       end if;
@@ -104,7 +105,7 @@ package body Switch.C is
                   Ptr := Ptr + 1;
 
                   if Ptr > Max then
-                     raise Bad_Switch;
+                     Bad_Switch (C);
                   end if;
 
                   --  Find out whether this is a -I- or regular -Ixxx switch
@@ -179,7 +180,7 @@ package body Switch.C is
                      end if;
                   end if;
                else
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
          when True =>
@@ -261,7 +262,7 @@ package body Switch.C is
                      Dot := True;
 
                   else
-                     raise Bad_Switch;
+                     Bad_Switch (C);
                   end if;
                end loop;
 
@@ -289,7 +290,7 @@ package body Switch.C is
                --  so we must always have a character after the e.
 
                if Ptr > Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                case Switch_Chars (Ptr) is
@@ -308,7 +309,7 @@ package body Switch.C is
                      end if;
 
                      if Ptr > Max then
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                      end if;
 
                      declare
@@ -351,7 +352,7 @@ package body Switch.C is
                      Ptr := Ptr + 1;
 
                      if Ptr > Max then
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                      end if;
 
                      Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
@@ -378,7 +379,8 @@ package body Switch.C is
 
                   when 'I' =>
                      Ptr := Ptr + 1;
-                     Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index);
+                     Scan_Pos
+                       (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
 
                   --  -gnatem (mapping file)
 
@@ -394,7 +396,7 @@ package body Switch.C is
                      end if;
 
                      if Ptr > Max then
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                      end if;
 
                      Mapping_File_Name :=
@@ -415,7 +417,7 @@ package body Switch.C is
                      end if;
 
                      if Ptr > Max then
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                      end if;
 
                      Preprocessing_Data_File :=
@@ -446,7 +448,7 @@ package body Switch.C is
                   --  All other -gnate? switches are unassigned
 
                   when others =>
-                     raise Bad_Switch;
+                     Bad_Switch (C);
                end case;
 
             --  -gnatE (dynamic elaboration checks)
@@ -502,7 +504,7 @@ package body Switch.C is
                Warn_On_Unchecked_Conversion := True;
                Warn_On_Unrecognized_Pragma  := True;
 
-               Set_Style_Check_Options ("3abcdefhiklmnprstu");
+               Set_Style_Check_Options ("3abcdefhiklmnprstux");
 
             --  Processing for G switch
 
@@ -526,7 +528,7 @@ package body Switch.C is
 
             when 'i' =>
                if Ptr = Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                Ptr := Ptr + 1;
@@ -544,14 +546,15 @@ package body Switch.C is
                   Ptr := Ptr + 1;
 
                else
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
             --  Processing for k switch
 
             when 'k' =>
                Ptr := Ptr + 1;
-               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
+                  Scan_Pos
+                    (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
 
             --  Processing for l switch
 
@@ -570,7 +573,14 @@ package body Switch.C is
 
             when 'm' =>
                Ptr := Ptr + 1;
-               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
+
+               --  There may be an equal sign between -gnatm and the value
+
+               if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
+                  Ptr := Ptr + 1;
+               end if;
+
+               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors, C);
 
             --  Processing for n switch
 
@@ -603,7 +613,18 @@ package body Switch.C is
 
             when 'p' =>
                Ptr := Ptr + 1;
-               Suppress_Options           := (others => True);
+
+               --  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;
@@ -648,7 +669,7 @@ package body Switch.C is
                      List_Representation_Info_Mechanisms := True;
 
                   else
-                     raise Bad_Switch;
+                     Bad_Switch (C);
                   end if;
 
                   Ptr := Ptr + 1;
@@ -687,7 +708,7 @@ package body Switch.C is
 
             when 'T' =>
                Ptr := Ptr + 1;
-               Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);
+               Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
 
             --  Processing for u switch
 
@@ -715,7 +736,7 @@ package body Switch.C is
                Ptr := Ptr + 1;
 
                if Ptr > Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
 
                else
                   declare
@@ -726,7 +747,7 @@ package body Switch.C is
                        (Switch_Chars (Ptr .. Max), OK, Ptr);
 
                      if not OK then
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                      end if;
 
                      for Index in First_Char + 1 .. Max loop
@@ -748,188 +769,17 @@ package body Switch.C is
                Ptr := Ptr + 1;
 
                if Ptr > Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                while Ptr <= Max loop
                   C := Switch_Chars (Ptr);
 
-                  case C is
-                     when 'a' =>
-                        Check_Unreferenced              := True;
-                        Check_Unreferenced_Formals      := True;
-                        Check_Withs                     := True;
-                        Constant_Condition_Warnings     := True;
-                        Implementation_Unit_Warnings    := True;
-                        Ineffective_Inline_Warnings     := True;
-                        Warn_On_Ada_2005_Compatibility  := True;
-                        Warn_On_Bad_Fixed_Value         := True;
-                        Warn_On_Constant                := True;
-                        Warn_On_Export_Import           := True;
-                        Warn_On_Modified_Unread         := True;
-                        Warn_On_No_Value_Assigned       := True;
-                        Warn_On_Obsolescent_Feature     := True;
-                        Warn_On_Redundant_Constructs    := True;
-                        Warn_On_Unchecked_Conversion    := True;
-                        Warn_On_Unrecognized_Pragma     := True;
-
-                     when 'A' =>
-                        Check_Unreferenced              := False;
-                        Check_Unreferenced_Formals      := False;
-                        Check_Withs                     := False;
-                        Constant_Condition_Warnings     := False;
-                        Elab_Warnings                   := False;
-                        Implementation_Unit_Warnings    := False;
-                        Ineffective_Inline_Warnings     := False;
-                        Warn_On_Ada_2005_Compatibility  := False;
-                        Warn_On_Bad_Fixed_Value         := False;
-                        Warn_On_Constant                := False;
-                        Warn_On_Dereference             := False;
-                        Warn_On_Export_Import           := False;
-                        Warn_On_Hiding                  := False;
-                        Warn_On_Modified_Unread         := False;
-                        Warn_On_No_Value_Assigned       := False;
-                        Warn_On_Obsolescent_Feature     := False;
-                        Warn_On_Redundant_Constructs    := False;
-                        Warn_On_Unchecked_Conversion    := False;
-                        Warn_On_Unrecognized_Pragma     := False;
-
-                     when 'b' =>
-                        Warn_On_Bad_Fixed_Value         := True;
-
-                     when 'B' =>
-                        Warn_On_Bad_Fixed_Value         := False;
-
-                     when 'c' =>
-                        Constant_Condition_Warnings     := True;
-
-                     when 'C' =>
-                        Constant_Condition_Warnings     := False;
-
-                     when 'd' =>
-                        Warn_On_Dereference             := True;
-
-                     when 'D' =>
-                        Warn_On_Dereference             := False;
-
-                     when 'e' =>
-                        Warning_Mode                    := Treat_As_Error;
-
-                     when 'f' =>
-                        Check_Unreferenced_Formals      := True;
-
-                     when 'F' =>
-                        Check_Unreferenced_Formals      := False;
-
-                     when 'g' =>
-                        Warn_On_Unrecognized_Pragma     := True;
-
-                     when 'G' =>
-                        Warn_On_Unrecognized_Pragma     := False;
-
-                     when 'h' =>
-                        Warn_On_Hiding                  := True;
-
-                     when 'H' =>
-                        Warn_On_Hiding                  := False;
-
-                     when 'i' =>
-                        Implementation_Unit_Warnings    := True;
-
-                     when 'I' =>
-                        Implementation_Unit_Warnings    := False;
-
-                     when 'j' =>
-                        Warn_On_Obsolescent_Feature     := True;
-
-                     when 'J' =>
-                        Warn_On_Obsolescent_Feature     := False;
-
-                     when 'k' =>
-                        Warn_On_Constant                := True;
-
-                     when 'K' =>
-                        Warn_On_Constant                := False;
-
-                     when 'l' =>
-                        Elab_Warnings                   := True;
-
-                     when 'L' =>
-                        Elab_Warnings                   := False;
-
-                     when 'm' =>
-                        Warn_On_Modified_Unread         := True;
-
-                     when 'M' =>
-                        Warn_On_Modified_Unread         := False;
-
-                     when 'n' =>
-                        Warning_Mode                    := Normal;
-
-                     when 'o' =>
-                        Address_Clause_Overlay_Warnings := True;
-
-                     when 'O' =>
-                        Address_Clause_Overlay_Warnings := False;
-
-                     when 'p' =>
-                        Ineffective_Inline_Warnings     := True;
-
-                     when 'P' =>
-                        Ineffective_Inline_Warnings     := False;
-
-                     when 'r' =>
-                        Warn_On_Redundant_Constructs    := True;
-
-                     when 'R' =>
-                        Warn_On_Redundant_Constructs    := False;
-
-                     when 's' =>
-                        Warning_Mode                    := Suppress;
-
-                     when 'u' =>
-                        Check_Unreferenced              := True;
-                        Check_Withs                     := True;
-                        Check_Unreferenced_Formals      := True;
-
-                     when 'U' =>
-                        Check_Unreferenced              := False;
-                        Check_Withs                     := False;
-                        Check_Unreferenced_Formals      := False;
-
-                     when 'v' =>
-                        Warn_On_No_Value_Assigned       := True;
-
-                     when 'V' =>
-                        Warn_On_No_Value_Assigned       := False;
-
-                     when 'x' =>
-                        Warn_On_Export_Import           := True;
-
-                     when 'X' =>
-                        Warn_On_Export_Import           := False;
-
-                     when 'y' =>
-                        Warn_On_Ada_2005_Compatibility  := True;
-
-                     when 'Y' =>
-                        Warn_On_Ada_2005_Compatibility  := False;
-
-                     when 'z' =>
-                        Warn_On_Unchecked_Conversion    := True;
-
-                     when 'Z' =>
-                        Warn_On_Unchecked_Conversion    := False;
-
-                        --  Allow and ignore 'w' so that the old
-                        --  format (e.g. -gnatwuwl) will work.
-
-                     when 'w' =>
-                        null;
-
-                     when others =>
-                        raise Bad_Switch;
-                  end case;
+                  if Set_Warning_Switch (C) then
+                     null;
+                  else
+                     Bad_Switch (C);
+                  end if;
 
                   if C /= 'w' then
                      Storing (First_Stored + 1) := C;
@@ -948,7 +798,7 @@ package body Switch.C is
                Ptr := Ptr + 1;
 
                if Ptr > Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                for J in WC_Encoding_Method loop
@@ -957,7 +807,7 @@ package body Switch.C is
                      exit;
 
                   elsif J = WC_Encoding_Method'Last then
-                     raise Bad_Switch;
+                     Bad_Switch (C);
                   end if;
                end loop;
 
@@ -1002,7 +852,7 @@ package body Switch.C is
                        (Switch_Chars (Ptr .. Max), OK, Ptr);
 
                      if not OK then
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                      end if;
 
                      Ptr := First_Char + 1;
@@ -1047,7 +897,7 @@ package body Switch.C is
                         Distribution_Stub_Mode := Generate_Caller_Stub_Body;
 
                      when others =>
-                        raise Bad_Switch;
+                        Bad_Switch (C);
                   end case;
 
                   Ptr := Ptr + 1;
@@ -1065,13 +915,13 @@ package body Switch.C is
 
             when '8' =>
                if Ptr = Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                Ptr := Ptr + 1;
 
                if Switch_Chars (Ptr) /= '3' then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                else
                   Ptr := Ptr + 1;
                   Ada_Version := Ada_83;
@@ -1082,13 +932,13 @@ package body Switch.C is
 
             when '9' =>
                if Ptr = Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                Ptr := Ptr + 1;
 
                if Switch_Chars (Ptr) /= '5' then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                else
                   Ptr := Ptr + 1;
                   Ada_Version := Ada_95;
@@ -1099,13 +949,13 @@ package body Switch.C is
 
             when '0' =>
                if Ptr = Max then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                end if;
 
                Ptr := Ptr + 1;
 
                if Switch_Chars (Ptr) /= '5' then
-                  raise Bad_Switch;
+                  Bad_Switch (C);
                else
                   Ptr := Ptr + 1;
                   Ada_Version := Ada_05;
@@ -1120,7 +970,7 @@ package body Switch.C is
             --  Anything else is an error (illegal switch character)
 
             when others =>
-               raise Bad_Switch;
+               Bad_Switch (C);
             end case;
          end case;
 
@@ -1133,17 +983,6 @@ package body Switch.C is
 
          First_Switch := False;
       end loop;
-
-   exception
-      when Bad_Switch =>
-         Osint.Fail ("invalid switch: ", (1 => C));
-
-      when Bad_Switch_Value =>
-         Osint.Fail ("numeric value out of range for switch: ", (1 => C));
-
-      when Missing_Switch_Value =>
-         Osint.Fail ("missing numeric value for switch: ", (1 => C));
-
    end Scan_Front_End_Switches;
 
 end Switch.C;
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index ea8a949afb2..2367a91c2ff 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, 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- --
@@ -311,14 +311,14 @@ package Types is
    --  is in practice infinite and there is no need to check the range.
 
    Ureal_Low_Bound : constant := 500_000_000;
-   --  Low bound for Ureal values.
+   --  Low bound for Ureal values
 
    Ureal_High_Bound : constant := 599_999_999;
    --  Maximum number of Ureal values stored is 100_000_000 which is in
    --  practice infinite so that no check is required.
 
    Uint_Low_Bound : constant := 600_000_000;
-   --  Low bound for Uint values.
+   --  Low bound for Uint values
 
    Uint_Table_Start : constant := 2_000_000_000;
    --  Location where table entries for universal integers start (see
@@ -479,7 +479,7 @@ package Types is
    --  are not valid.
 
    First_Elist_Id : constant Elist_Id := No_Elist + 1;
-   --  Subscript of first allocated Elist header.
+   --  Subscript of first allocated Elist header
 
    --  Element Id values are used to identify individual elements of an
    --  element list (see package Elists for further details).
@@ -696,12 +696,19 @@ package Types is
       Tag_Check,
       All_Checks);
 
-   --  The following record contains an entry for each recognized check name
+   --  The following array contains an entry for each recognized check name
    --  for pragma Suppress. It is used to represent current settings of scope
    --  based suppress actions from pragma Suppress or command line settings.
 
-   type Suppress_Array is
-     array (Check_Id range Access_Check .. Tag_Check) of Boolean;
+   --  Note: when Suppress_Array (All_Checks) is True, then generally all other
+   --  specific check entries are set True, except for the Elaboration_Check
+   --  entry which is set only if an explicit Suppress for this check is given.
+   --  The reason for this non-uniformity is that we do not want All_Checks to
+   --  suppress elaboration checking when using the static elaboration model.
+   --  We recognize only an explicit suppress of Elaboration_Check as a signal
+   --  that the static elaboration checking should skip a compile time check.
+
+   type Suppress_Array is array (Check_Id) of Boolean;
    pragma Pack (Suppress_Array);
 
    --  To add a new check type to GNAT, the following steps are required: