From 3a0462b3e6dd2c22843f7715dd49d2ce28883835 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 15 Feb 2006 10:36:02 +0100 Subject: [PATCH] err_vars.ads: Suppress range checks for a couple of assignments which otherwise cause... 2006-02-13 Robert Dewar Eric Botcazou * 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 | 89 ++++++++++++++++++++++++++------------------ gcc/ada/errout.adb | 33 ++++++++++------ gcc/ada/errout.ads | 29 +++++++++------ gcc/ada/gnat1drv.adb | 21 ++++++++--- 4 files changed, 106 insertions(+), 66 deletions(-) diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 1abc4acbe12..66a33fa9d10 100644 --- a/gcc/ada/err_vars.ads +++ b/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; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index d699828d395..889c0e5cee2 100644 --- a/gcc/ada/errout.adb +++ b/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. - 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; ------------------ diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 5aa7f7f13d5..62556d8412b 100644 --- a/gcc/ada/errout.ads +++ b/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 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 32720d5cecc..44c58d0fcac 100644 --- a/gcc/ada/gnat1drv.adb +++ b/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 + <> + null; + + -- The outer exception handles an unrecoverable error exception when Unrecoverable_Error => -- 2.30.2