aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.7/gcc/ada/binderr.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.7/gcc/ada/binderr.adb')
-rw-r--r--gcc-4.7/gcc/ada/binderr.adb233
1 files changed, 233 insertions, 0 deletions
diff --git a/gcc-4.7/gcc/ada/binderr.adb b/gcc-4.7/gcc/ada/binderr.adb
new file mode 100644
index 000000000..830a2f177
--- /dev/null
+++ b/gcc-4.7/gcc/ada/binderr.adb
@@ -0,0 +1,233 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- B I N D E R R --
+-- --
+-- B o d y --
+-- --
+-- 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 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 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 Butil; use Butil;
+with Opt; use Opt;
+with Output; use Output;
+
+package body Binderr is
+
+ ---------------
+ -- Error_Msg --
+ ---------------
+
+ procedure Error_Msg (Msg : String) is
+ begin
+ if Msg (Msg'First) = '?' then
+ if Warning_Mode = Suppress then
+ return;
+ end if;
+
+ if Warning_Mode = Treat_As_Error then
+ Errors_Detected := Errors_Detected + 1;
+ else
+ Warnings_Detected := Warnings_Detected + 1;
+ end if;
+
+ else
+ Errors_Detected := Errors_Detected + 1;
+ end if;
+
+ if Brief_Output or else (not Verbose_Mode) then
+ Set_Standard_Error;
+ Error_Msg_Output (Msg, Info => False);
+ Set_Standard_Output;
+ end if;
+
+ if Verbose_Mode then
+ if Errors_Detected + Warnings_Detected = 0 then
+ Write_Eol;
+ end if;
+
+ Error_Msg_Output (Msg, Info => False);
+ end if;
+
+ -- 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;
+
+ --------------------
+ -- Error_Msg_Info --
+ --------------------
+
+ procedure Error_Msg_Info (Msg : String) is
+ begin
+ if Brief_Output or else (not Verbose_Mode) then
+ Set_Standard_Error;
+ Error_Msg_Output (Msg, Info => True);
+ Set_Standard_Output;
+ end if;
+
+ if Verbose_Mode then
+ Error_Msg_Output (Msg, Info => True);
+ end if;
+
+ end Error_Msg_Info;
+
+ ----------------------
+ -- Error_Msg_Output --
+ ----------------------
+
+ procedure Error_Msg_Output (Msg : String; Info : Boolean) is
+ 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_Messages then
+ Write_Str ("error: maximum errors exceeded");
+ Write_Eol;
+ return;
+ end if;
+
+ -- 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 ("info: ");
+ end if;
+ else
+ Write_Str ("error: ");
+ end if;
+
+ 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 ('"');
+
+ elsif Msg (J) = '{' then
+ if Use_Second_File then
+ Get_Name_String (Error_Msg_File_2);
+ else
+ 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 (J) = '$' then
+ Write_Char ('"');
+
+ if Use_Second_Unit then
+ Write_Unit_Name (Error_Msg_Unit_2);
+ else
+ Use_Second_Unit := True;
+ Write_Unit_Name (Error_Msg_Unit_1);
+ end if;
+
+ Write_Char ('"');
+
+ 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;
+
+ Write_Eol;
+ end Error_Msg_Output;
+
+ ----------------------
+ -- Finalize_Binderr --
+ ----------------------
+
+ procedure Finalize_Binderr is
+ begin
+ -- Message giving number of errors detected (verbose mode only)
+
+ if Verbose_Mode then
+ Write_Eol;
+
+ if Errors_Detected = 0 then
+ Write_Str ("No errors");
+
+ elsif Errors_Detected = 1 then
+ Write_Str ("1 error");
+
+ else
+ Write_Int (Errors_Detected);
+ Write_Str (" errors");
+ end if;
+
+ if Warnings_Detected = 1 then
+ Write_Str (", 1 warning");
+
+ elsif Warnings_Detected > 1 then
+ Write_Str (", ");
+ Write_Int (Warnings_Detected);
+ Write_Str (" warnings");
+ end if;
+
+ Write_Eol;
+ end if;
+ end Finalize_Binderr;
+
+ ------------------------
+ -- Initialize_Binderr --
+ ------------------------
+
+ procedure Initialize_Binderr is
+ begin
+ Errors_Detected := 0;
+ Warnings_Detected := 0;
+ end Initialize_Binderr;
+
+end Binderr;