re PR ada/18434 (Ada: cannot build gnattools on Tru64 UNIX V5.1B)

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)

From-SVN: r106950

1 files changed, 60 insertions, 221 deletions

diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index c89eb1b..fe7545e 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;