err_vars.ads: Suppress range checks for a couple of assignments which otherwise cause...

2006-02-13  Robert Dewar  <dewar@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* err_vars.ads: Suppress range checks for a couple of assignments
	which otherwise cause validity checks with validity checking turned on.
	Update comments.

	* errout.adb (Error_Msg_Internal): Do not suppress warning messages.
	Make message unconditional if it is a warning.
	(Error_Msg_NEL): Always output warning messages.
	Suppress range checks for a couple of assignments which otherwise
	cause validity checks with validity checking turned on.

	* errout.ads (Message Insertion Characters): Document that '!' is
	implied by '?' in error messages.

	* gnat1drv.adb: (Bad_Body): Remove '!' in warning message.
	(Gnat1drv): Use a goto to end of main subprogram instead of
	Exit_Program (E_Success) so that finalization can occur normally.

From-SVN: r111049

gcc/ada/err_vars.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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,28 +32,50 @@ with Uintp; use Uintp;
 
 package Err_Vars is
 
+   ------------------
+   -- Error Counts --
+   ------------------
+
    Serious_Errors_Detected : Nat;
    --  This is a count of errors that are serious enough to stop expansion,
    --  and hence to prevent generation of an object file even if the
-   --  switch -gnatQ is set.
+   --  switch -gnatQ is set. Initialized to zero at the start of compilation.
 
    Total_Errors_Detected : Nat;
-   --  Number of errors detected so far. Includes count of serious errors
-   --  and non-serious errors, so this value is always greater than or
-   --  equal to the Serious_Errors_Detected value.
+   --  Number of errors detected so far. Includes count of serious errors and
+   --  non-serious errors, so this value is always greater than or equal to the
+   --  Serious_Errors_Detected value. Initialized to zero at the start of
+   --  compilation.
 
    Warnings_Detected : Nat;
-   --  Number of warnings detected
+   --  Number of warnings detected. Initialized to zero at the start of
+   --  compilation.
 
-   Current_Error_Source_File : Source_File_Index;
-   --  Id of current messages. Used to post file name when unit changes. This
-   --  is initialized to Main_Source_File at the start of a compilation, which
-   --  means that no file names will be output unless there are errors in units
-   --  other than the main unit. However, if the main unit has a pragma
-   --  Source_Reference line, then this is initialized to No_Source_File,
-   --  to force an initial reference to the real source file name.
+   ----------------------------------
+   -- Error Message Mode Variables --
+   ----------------------------------
+
+   --  These variables control special error message modes. The initialized
+   --  values below give the normal default behavior, but they can be reset
+   --  by the caller to get different behavior as noted in the comments. These
+   --  variables are not reset by calls to the error message routines, so the
+   --  caller is responsible for resetting the default behavior after use.
+
+   Error_Msg_Qual_Level : Int;
+   --  Number of levels of qualification required for type name (see the
+   --  description of the } insertion character. Note that this value does
+   --  note get reset by any Error_Msg call, so the caller is responsible
+   --  for resetting it.
+
+   Warn_On_Instance : Boolean;
+   --  Normally if a warning is generated in a generic template from the
+   --  analysis of the template, then the warning really belongs in the
+   --  template, and the default value of False for this Boolean achieves
+   --  that effect. If Warn_On_Instance is set True, then the warnings are
+   --  generated on the instantiation (referring to the template) rather
+   --  than on the template itself.
 
-   Raise_Exception_On_Error : Nat := 0;
+   Raise_Exception_On_Error : Nat;
    --  If this value is non-zero, then any attempt to generate an error
    --  message raises the exception Error_Msg_Exception, and the error
    --  message is not output. This is used for defending against junk
@@ -64,15 +86,24 @@ package Err_Vars is
    Error_Msg_Exception : exception;
    --  Exception raised if Raise_Exception_On_Error is true
 
-   -----------------------------------------------------
-   -- Global Values Used for Error Message Insertions --
-   -----------------------------------------------------
+   Current_Error_Source_File : Source_File_Index := Internal_Source_File;
+   --  Id of current messages. Used to post file name when unit changes. This
+   --  is initialized to Main_Source_File at the start of a compilation, which
+   --  means that no file names will be output unless there are errors in units
+   --  other than the main unit. However, if the main unit has a pragma
+   --  Source_Reference line, then this is initialized to No_Source_File,
+   --  to force an initial reference to the real source file name.
+
+   ----------------------------------------
+   -- Error Message Insertion Parameters --
+   ----------------------------------------
 
-   --  The following global variables are essentially additional parameters
-   --  passed to the error message routine for insertion sequences described
-   --  above. The reason these are passed globally is that the insertion
-   --  mechanism is essentially an untyped one in which the appropriate
-   --  variables are set dependingon the specific insertion characters used.
+   --  The error message routines work with strings that contain insertion
+   --  sequences that result in the insertion of variable data. The following
+   --  variables contain the required data. The procedure is to set one or more
+   --  of the following global variables to appropriate values before making a
+   --  call to one of the error message routines with a string containing the
+   --  insertion character to get the value inserted in an appropriate format.
 
    Error_Msg_Col : Column_Number;
    --  Column for @ insertion character in message
@@ -97,22 +128,8 @@ package Err_Vars is
    Error_Msg_Node_2 : Node_Id;
    --  Node_Id values for & insertion characters in message
 
-   Error_Msg_Qual_Level : Int := 0;
-   --  Number of levels of qualification required for type name (see the
-   --  description of the } insertion character. Note that this value does
-   --  note get reset by any Error_Msg call, so the caller is responsible
-   --  for resetting it.
-
    Error_Msg_Warn : Boolean;
    --  Used if current message contains a < insertion character to indicate
    --  if the current message is a warning message.
 
-   Warn_On_Instance : Boolean := False;
-   --  Normally if a warning is generated in a generic template from the
-   --  analysis of the template, then the warning really belongs in the
-   --  template, and the default value of False for this Boolean achieves
-   --  that effect. If Warn_On_Instance is set True, then the warnings are
-   --  generated on the instantiation (referring to the template) rather
-   --  than on the template itself.
-
 end Err_Vars;

gcc/ada/errout.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -691,6 +691,7 @@ package body Errout is
       if Suppress_Message
         and not All_Errors_Mode
         and not (Msg (Msg'Last) = '!')
+        and not Is_Warning_Msg
       then
          if not Continuation then
             Last_Killed := True;
@@ -780,7 +781,8 @@ package body Errout is
       Errors.Table (Cur_Msg).Warn     := Is_Warning_Msg;
       Errors.Table (Cur_Msg).Style    := Is_Style_Msg;
       Errors.Table (Cur_Msg).Serious  := Is_Serious_Error;
-      Errors.Table (Cur_Msg).Uncond   := Is_Unconditional_Msg;
+      Errors.Table (Cur_Msg).Uncond
+        := Is_Unconditional_Msg or Is_Warning_Msg;
       Errors.Table (Cur_Msg).Msg_Cont := Continuation;
       Errors.Table (Cur_Msg).Deleted  := False;
 
@@ -1005,6 +1007,7 @@ package body Errout is
 
       if All_Errors_Mode
         or else Msg (Msg'Last) = '!'
+        or else Is_Warning_Msg
         or else OK_Node (N)
         or else (Msg (Msg'First) = '\' and not Last_Killed)
       then
@@ -1431,12 +1434,6 @@ package body Errout is
          Warnings.Table (Warnings.Last).Start := Source_Ptr'First;
          Warnings.Table (Warnings.Last).Stop  := Source_Ptr'Last;
       end if;
-
-      --  Set the error nodes to Empty to avoid uninitialized variable
-      --  references for saves/restores/moves.
-
-      Error_Msg_Node_1 := Empty;
-      Error_Msg_Node_2 := Empty;
    end Initialize;
 
    -----------------
@@ -1867,9 +1864,15 @@ package body Errout is
       end if;
 
       --  The following assignment ensures that a second ampersand insertion
-      --  character will correspond to the Error_Msg_Node_2 parameter.
+      --  character will correspond to the Error_Msg_Node_2 parameter. We
+      --  suppress possible validity checks in case operating in -gnatVa mode,
+      --  and Error_Msg_Node_2 is not needed and has not been set.
 
+      declare
+         pragma Suppress (Range_Check);
+      begin
          Error_Msg_Node_1 := Error_Msg_Node_2;
+      end;
    end Set_Msg_Insertion_Node;
 
    --------------------------------------
@@ -2042,9 +2045,15 @@ package body Errout is
       end if;
 
       --  The following assignment ensures that a second percent insertion
-      --  character will correspond to the Error_Msg_Unit_2 parameter.
+      --  character will correspond to the Error_Msg_Unit_2 parameter. We
+      --  suppress possible validity checks in case operating in -gnatVa mode,
+      --  and Error_Msg_Unit_2 is not needed and has not been set.
 
+      declare
+         pragma Suppress (Range_Check);
+      begin
          Error_Msg_Unit_1 := Error_Msg_Unit_2;
+      end;
    end Set_Msg_Insertion_Unit_Name;
 
    ------------------

gcc/ada/errout.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -118,6 +118,9 @@ package Errout is
    --    5.  If a message attempts to insert an Error node, or a direct
    --        reference to the Any_Type node, then the message is suppressed.
 
+   --    6.  Note that cases 2-5 only apply to error messages, not warning
+   --        messages. Warning messages are only suppressed for case 1.
+
    --  This normal suppression action may be overridden in cases 2-5 (but not
    --  in case 1) by setting All_Errors mode, or by setting the special
    --  unconditional message insertion character (!) at the end of the message
@@ -229,19 +232,21 @@ package Errout is
    --      The character ! appearing as the last character of a message makes
    --      the message unconditional which means that it is output even if it
    --      would normally be suppressed. See section above for a description
-   --      of the cases in which messages are normally suppressed.
+   --      of the cases in which messages are normally suppressed. Note that
+   --      warnings are never suppressed, so the use of the ! character in a
+   --      warning message is never useful.
 
    --    Insertion character ? (Question: warning message)
-   --      The character ? appearing anywhere in a message makes the message
-   --      a warning instead of a normal error message, and the text of the
-   --      message will be preceded by "Warning:" instead of "Error:" The
-   --      handling of warnings if further controlled by the Warning_Mode
-   --      option (-w switch), see package Opt for further details, and also
-   --      by the current setting from pragma Warnings. This pragma applies
-   --      only to warnings issued from the semantic phase (not the parser),
-   --      but currently all relevant warnings are posted by the semantic
-   --      phase anyway. Messages starting with (style) are also treated as
-   --      warning messages.
+   --      The character ? appearing anywhere in a message makes the message a
+   --      warning instead of a normal error message, and the text of the
+   --      message will be preceded by "Warning:" instead of "Error:" in the
+   --      normal case. The handling of warnings if further controlled by the
+   --      Warning_Mode option (-w switch), see package Opt for further
+   --      details, and also by the current setting from pragma Warnings. This
+   --      pragma applies only to warnings issued from the semantic phase (not
+   --      the parser), but currently all relevant warnings are posted by the
+   --      semantic phase anyway. Messages starting with (style) are also
+   --      treated as warning messages.
 
    --    Insertion character < (Less Than: conditional warning message)
    --      The character < appearing anywhere in a message is used for a

gcc/ada/gnat1drv.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006 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- --
@@ -179,7 +179,9 @@ begin
          Write_Str ("GNAT ");
          Write_Str (Gnat_Version_String);
          Write_Eol;
-         Write_Str ("Copyright 1992-2005 Free Software Foundation, Inc.");
+         Write_Str ("Copyright 1992-" &
+                    Current_Year &
+                    ", Free Software Foundation, Inc.");
          Write_Eol;
       end if;
 
@@ -330,10 +332,10 @@ begin
                  and then not Compilation_Errors
                then
                   Error_Msg_N
-                    ("package % does not require a body?!", Main_Unit_Node);
+                    ("package % does not require a body?", Main_Unit_Node);
                   Error_Msg_Name_1 := Fname;
                   Error_Msg_N
-                    ("body in file{?! will be ignored", Main_Unit_Node);
+                    ("body in file{? will be ignored", Main_Unit_Node);
 
                --  Ada 95 cases of a body file present when no body is
                --  permitted. This we consider to be an error.
@@ -416,7 +418,11 @@ begin
          Errout.Finalize;
          Tree_Gen;
          Namet.Finalize;
-         Exit_Program (E_Success);
+
+         --  Use a goto instead of calling Exit_Program so that finalization
+         --  occurs normally.
+
+         goto End_Of_Program;
 
       elsif Original_Operating_Mode = Check_Semantics then
          Back_End_Mode := Declarations_Only;
@@ -683,7 +689,10 @@ begin
          Comperr.Compiler_Abort ("Storage_Error");
    end;
 
---  The outer exception handles an unrecoverable error
+   <<End_Of_Program>>
+   null;
+
+   --  The outer exception handles an unrecoverable error
 
 exception
    when Unrecoverable_Error =>