1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- B I N D E R R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2002 Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 2, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Butil; use Butil; 28with Namet; use Namet; 29with Opt; use Opt; 30with Output; use Output; 31 32package body Binderr is 33 34 --------------- 35 -- Error_Msg -- 36 --------------- 37 38 procedure Error_Msg (Msg : String) is 39 begin 40 if Msg (Msg'First) = '?' then 41 if Warning_Mode = Suppress then 42 return; 43 end if; 44 45 if Warning_Mode = Treat_As_Error then 46 Errors_Detected := Errors_Detected + 1; 47 else 48 Warnings_Detected := Warnings_Detected + 1; 49 end if; 50 51 else 52 Errors_Detected := Errors_Detected + 1; 53 end if; 54 55 if Brief_Output or else (not Verbose_Mode) then 56 Set_Standard_Error; 57 Error_Msg_Output (Msg, Info => False); 58 Set_Standard_Output; 59 end if; 60 61 if Verbose_Mode then 62 if Errors_Detected + Warnings_Detected = 0 then 63 Write_Eol; 64 end if; 65 66 Error_Msg_Output (Msg, Info => False); 67 end if; 68 69 if Warnings_Detected + Errors_Detected > Maximum_Errors then 70 raise Unrecoverable_Error; 71 end if; 72 73 end Error_Msg; 74 75 -------------------- 76 -- Error_Msg_Info -- 77 -------------------- 78 79 procedure Error_Msg_Info (Msg : String) is 80 begin 81 if Brief_Output or else (not Verbose_Mode) then 82 Set_Standard_Error; 83 Error_Msg_Output (Msg, Info => True); 84 Set_Standard_Output; 85 end if; 86 87 if Verbose_Mode then 88 Error_Msg_Output (Msg, Info => True); 89 end if; 90 91 end Error_Msg_Info; 92 93 ---------------------- 94 -- Error_Msg_Output -- 95 ---------------------- 96 97 procedure Error_Msg_Output (Msg : String; Info : Boolean) is 98 Use_Second_Name : Boolean := False; 99 Use_Second_Nat : Boolean := False; 100 101 begin 102 if Warnings_Detected + Errors_Detected > Maximum_Errors then 103 Write_Str ("error: maximum errors exceeded"); 104 Write_Eol; 105 return; 106 end if; 107 108 if Msg (Msg'First) = '?' then 109 Write_Str ("warning: "); 110 elsif Info then 111 if not Info_Prefix_Suppress then 112 Write_Str ("info: "); 113 end if; 114 else 115 Write_Str ("error: "); 116 end if; 117 118 for J in Msg'Range loop 119 if Msg (J) = '%' then 120 121 if Use_Second_Name then 122 Get_Name_String (Error_Msg_Name_2); 123 else 124 Use_Second_Name := True; 125 Get_Name_String (Error_Msg_Name_1); 126 end if; 127 128 Write_Char ('"'); 129 Write_Str (Name_Buffer (1 .. Name_Len)); 130 Write_Char ('"'); 131 132 elsif Msg (J) = '&' then 133 Write_Char ('"'); 134 135 if Use_Second_Name then 136 Write_Unit_Name (Error_Msg_Name_2); 137 else 138 Use_Second_Name := True; 139 Write_Unit_Name (Error_Msg_Name_1); 140 end if; 141 142 Write_Char ('"'); 143 144 elsif Msg (J) = '#' then 145 if Use_Second_Nat then 146 Write_Int (Error_Msg_Nat_2); 147 else 148 Use_Second_Nat := True; 149 Write_Int (Error_Msg_Nat_1); 150 end if; 151 152 elsif Msg (J) /= '?' then 153 Write_Char (Msg (J)); 154 end if; 155 end loop; 156 157 Write_Eol; 158 end Error_Msg_Output; 159 160 ---------------------- 161 -- Finalize_Binderr -- 162 ---------------------- 163 164 procedure Finalize_Binderr is 165 begin 166 -- Message giving number of errors detected (verbose mode only) 167 168 if Verbose_Mode then 169 Write_Eol; 170 171 if Errors_Detected = 0 then 172 Write_Str ("No errors"); 173 174 elsif Errors_Detected = 1 then 175 Write_Str ("1 error"); 176 177 else 178 Write_Int (Errors_Detected); 179 Write_Str (" errors"); 180 end if; 181 182 if Warnings_Detected = 1 then 183 Write_Str (", 1 warning"); 184 185 elsif Warnings_Detected > 1 then 186 Write_Str (", "); 187 Write_Int (Warnings_Detected); 188 Write_Str (" warnings"); 189 end if; 190 191 Write_Eol; 192 end if; 193 end Finalize_Binderr; 194 195 ------------------------ 196 -- Initialize_Binderr -- 197 ------------------------ 198 199 procedure Initialize_Binderr is 200 begin 201 Errors_Detected := 0; 202 Warnings_Detected := 0; 203 end Initialize_Binderr; 204 205end Binderr; 206