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