-- --
-- B o d y --
-- --
--- $Revision: 1.22 $
--- --
--- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-with Butil; use Butil;
-with Namet; use Namet;
-with Opt; use Opt;
-with Output; use Output;
+with Butil; use Butil;
+with Opt; use Opt;
+with Output; use Output;
package body Binderr is
Error_Msg_Output (Msg, Info => False);
end if;
- if Warnings_Detected + Errors_Detected > Maximum_Errors then
- raise Unrecoverable_Error;
+ -- If too many warnings print message and then turn off warnings
+
+ if Warnings_Detected = Maximum_Messages then
+ Set_Standard_Error;
+ Write_Line ("maximum number of warnings reached");
+ Write_Line ("further warnings will be suppressed");
+ Set_Standard_Output;
+ Warning_Mode := Suppress;
end if;
+ -- If too many errors print message and give fatal error
+
+ if Errors_Detected = Maximum_Messages then
+ Set_Standard_Error;
+ Write_Line ("fatal error: maximum number of errors exceeded");
+ Set_Standard_Output;
+ raise Unrecoverable_Error;
+ end if;
end Error_Msg;
--------------------
----------------------
procedure Error_Msg_Output (Msg : String; Info : Boolean) is
- Use_Second_Name : Boolean := False;
+ Use_Second_File : Boolean := False;
+ Use_Second_Unit : Boolean := False;
+ Use_Second_Nat : Boolean := False;
+ Warning : Boolean := False;
begin
- if Warnings_Detected + Errors_Detected > Maximum_Errors then
+ if Warnings_Detected + Errors_Detected > Maximum_Messages then
Write_Str ("error: maximum errors exceeded");
Write_Eol;
return;
end if;
- if Msg (Msg'First) = '?' then
+ -- First, check for warnings
+
+ for J in Msg'Range loop
+ if Msg (J) = '?' then
+ Warning := True;
+ exit;
+ end if;
+ end loop;
+
+ if Warning then
Write_Str ("warning: ");
elsif Info then
if not Info_Prefix_Suppress then
Write_Str ("error: ");
end if;
- for I in Msg'Range loop
- if Msg (I) = '%' then
+ for J in Msg'Range loop
+ if Msg (J) = '%' then
+ Get_Name_String (Error_Msg_Name_1);
+ Write_Char ('"');
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Char ('"');
- if Use_Second_Name then
- Get_Name_String (Error_Msg_Name_2);
+ elsif Msg (J) = '{' then
+ if Use_Second_File then
+ Get_Name_String (Error_Msg_File_2);
else
- Use_Second_Name := True;
- Get_Name_String (Error_Msg_Name_1);
+ Use_Second_File := True;
+ Get_Name_String (Error_Msg_File_1);
end if;
Write_Char ('"');
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Char ('"');
- elsif Msg (I) = '&' then
+ elsif Msg (J) = '$' then
Write_Char ('"');
- if Use_Second_Name then
- Write_Unit_Name (Error_Msg_Name_2);
+ if Use_Second_Unit then
+ Write_Unit_Name (Error_Msg_Unit_2);
else
- Use_Second_Name := True;
- Write_Unit_Name (Error_Msg_Name_1);
+ Use_Second_Unit := True;
+ Write_Unit_Name (Error_Msg_Unit_1);
end if;
Write_Char ('"');
- elsif Msg (I) /= '?' then
- Write_Char (Msg (I));
+ elsif Msg (J) = '#' then
+ if Use_Second_Nat then
+ Write_Int (Error_Msg_Nat_2);
+ else
+ Use_Second_Nat := True;
+ Write_Int (Error_Msg_Nat_1);
+ end if;
+
+ elsif Msg (J) /= '?' then
+ Write_Char (Msg (J));
end if;
end loop;
OSDN Git Service
