-- --
-- B o d y --
-- --
--- Copyright (C) 1991-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1991-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Output; use Output;
with Scans; use Scans;
with Sinput; use Sinput;
+with Stylesw; use Stylesw;
package body Errutil is
-----------------------
procedure Error_Msg_AP (Msg : String);
- -- Output a message just after the previous token.
+ -- Output a message just after the previous token
procedure Output_Source_Line
(L : Physical_Line_Number;
return;
end if;
- -- Return without doing anything if message is killed and this
- -- is not the first error message. The philosophy is that if we
- -- get a weird error message and we already have had a message,
- -- then we hope the weird message is a junk cascaded message
+ -- Return without doing anything if message is killed and this is not
+ -- the first error message. The philosophy is that if we get a weird
+ -- error message and we already have had a message, then we hope the
+ -- weird message is a junk cascaded message
- -- Immediate return if warning message and warnings are suppressed
+ -- Immediate return if warning message and warnings are suppressed.
-- Note that style messages are not warnings for this purpose.
if Is_Warning_Msg and then Warnings_Suppressed (Sptr) then
and then Errors.Table (Prev_Msg).Sfile =
Errors.Table (Cur_Msg).Sfile
then
- -- Don't delete unconditional messages and at this stage,
- -- don't delete continuation lines (we attempted to delete
- -- those earlier if the parent message was deleted.
+ -- Don't delete unconditional messages and at this stage, don't
+ -- delete continuation lines (we attempted to delete those earlier
+ -- if the parent message was deleted.
if not Errors.Table (Cur_Msg).Uncond
and then not Continuation
then
- -- Don't delete if prev msg is warning and new msg is
- -- an error. This is because we don't want a real error
- -- masked by a warning. In all other cases (that is parse
- -- errors for the same line that are not unconditional)
- -- we do delete the message. This helps to avoid
- -- junk extra messages from cascaded parsing errors
+ -- Don't delete if prev msg is warning and new msg is an error.
+ -- This is because we don't want a real error masked by a warning.
+ -- In all other cases (that is parse errors for the same line that
+ -- are not unconditional) we do delete the message. This helps to
+ -- avoid junk extra messages from cascaded parsing errors
if not (Errors.Table (Prev_Msg).Warn
- or
+ or else
Errors.Table (Prev_Msg).Style)
or else
(Errors.Table (Cur_Msg).Warn
- or
+ or else
Errors.Table (Cur_Msg).Style)
then
- -- All tests passed, delete the message by simply
- -- returning without any further processing.
+ -- All tests passed, delete the message by simply returning
+ -- without any further processing.
if not Continuation then
Last_Killed := True;
-- Bump appropriate statistics count
- if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
+ if Errors.Table (Cur_Msg).Warn
+ or else
+ Errors.Table (Cur_Msg).Style
+ then
Warnings_Detected := Warnings_Detected + 1;
+
else
Total_Errors_Detected := Total_Errors_Detected + 1;
Write_Eol;
end if;
-
end loop;
-- Then output errors, if any, for subsidiary units
Set_Standard_Output;
end if;
- if Maximum_Errors /= 0
- and then Total_Errors_Detected + Warnings_Detected = Maximum_Errors
- then
- Set_Standard_Error;
- Write_Str ("fatal error: maximum errors reached");
- Write_Eol;
- Set_Standard_Output;
+ if Maximum_Messages /= 0 then
+ if Warnings_Detected >= Maximum_Messages then
+ Set_Standard_Error;
+ Write_Line ("maximum number of warnings detected");
+ Warning_Mode := Suppress;
+ end if;
+
+ if Total_Errors_Detected >= Maximum_Messages then
+ Set_Standard_Error;
+ Write_Line ("fatal error: maximum errors reached");
+ Set_Standard_Output;
+ end if;
end if;
if Warning_Mode = Treat_As_Error then
Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
Warnings_Detected := 0;
end if;
-
end Finalize;
----------------
Warnings.Init;
+ if Warning_Mode = Suppress then
+ Warnings.Increment_Last;
+ Warnings.Table (Warnings.Last).Start := Source_Ptr'First;
+ Warnings.Table (Warnings.Last).Stop := Source_Ptr'Last;
+ end if;
end Initialize;
------------------------
procedure Set_Msg_Insertion_Column is
begin
- if Style.RM_Column_Check then
+ if RM_Column_Check then
Set_Msg_Str (" in column ");
Set_Msg_Int (Int (Error_Msg_Col) + 1);
end if;
-- Check for insertion character
if C = '%' then
- Set_Msg_Insertion_Name;
+ if P <= Text'Last and then Text (P) = '%' then
+ P := P + 1;
+ Set_Msg_Insertion_Name_Literal;
+ else
+ Set_Msg_Insertion_Name;
+ end if;
elsif C = '$' then
+
-- '$' is ignored
null;
Set_Msg_Insertion_File_Name;
elsif C = '}' then
+
-- '}' is ignored
null;
Set_Msg_Insertion_Reserved_Name;
elsif C = '&' then
+
-- '&' is ignored
null;
elsif C = '?' then
null;
+ elsif C = '<' then
+ null;
+
elsif C = '|' then
null;
OSDN Git Service
