mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-24 17:05:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Robert Dewar 2006-02-15 10:36:02 +01:00 committed by Arnaud Charlet
parent 7a5cf1d56a
commit 3a0462b3e6
4 changed files with 106 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
gcc/ada/err_vars.ads
View File

@ -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 --
----------------------------------
Raise_Exception_On_Error : Nat := 0;
-- 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;
-- 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.
-- 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.
----------------------------------------
-- Error Message Insertion Parameters --
----------------------------------------
-- 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;

33
gcc/ada/errout.adb
View File

@ -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.
Error_Msg_Node_1 := Error_Msg_Node_2;
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.
Error_Msg_Unit_1 := Error_Msg_Unit_2;
declare
pragma Suppress (Range_Check);
begin
Error_Msg_Unit_1 := Error_Msg_Unit_2;
end;
end Set_Msg_Insertion_Unit_Name;
------------------

29
gcc/ada/errout.ads
View File

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

21
gcc/ada/gnat1drv.adb
View File

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