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-2018, 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 3, 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 COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Butil; use Butil; 27with Opt; use Opt; 28with Output; use Output; 29 30package body Binderr is 31 32 --------------- 33 -- Error_Msg -- 34 --------------- 35 36 procedure Error_Msg (Msg : String) is 37 begin 38 if Msg (Msg'First) = '?' then 39 if Warning_Mode = Suppress then 40 return; 41 end if; 42 43 if Warning_Mode = Treat_As_Error then 44 Errors_Detected := Errors_Detected + 1; 45 else 46 Warnings_Detected := Warnings_Detected + 1; 47 end if; 48 49 else 50 Errors_Detected := Errors_Detected + 1; 51 end if; 52 53 if Brief_Output or else (not Verbose_Mode) then 54 Set_Standard_Error; 55 Error_Msg_Output (Msg, Info => False); 56 Set_Standard_Output; 57 end if; 58 59 if Verbose_Mode then 60 if Errors_Detected + Warnings_Detected = 0 then 61 Write_Eol; 62 end if; 63 64 Error_Msg_Output (Msg, Info => False); 65 end if; 66 67 -- If too many warnings print message and then turn off warnings 68 69 if Warnings_Detected = Maximum_Messages then 70 Set_Standard_Error; 71 Write_Line ("maximum number of warnings reached"); 72 Write_Line ("further warnings will be suppressed"); 73 Set_Standard_Output; 74 Warning_Mode := Suppress; 75 end if; 76 77 -- If too many errors print message and give fatal error 78 79 if Errors_Detected = Maximum_Messages then 80 Set_Standard_Error; 81 Write_Line ("fatal error: maximum number of errors exceeded"); 82 Set_Standard_Output; 83 raise Unrecoverable_Error; 84 end if; 85 end Error_Msg; 86 87 -------------------- 88 -- Error_Msg_Info -- 89 -------------------- 90 91 procedure Error_Msg_Info (Msg : String) is 92 begin 93 if Brief_Output or else (not Verbose_Mode) then 94 Set_Standard_Error; 95 Error_Msg_Output (Msg, Info => True); 96 Set_Standard_Output; 97 end if; 98 99 if Verbose_Mode then 100 Error_Msg_Output (Msg, Info => True); 101 end if; 102 103 end Error_Msg_Info; 104 105 ---------------------- 106 -- Error_Msg_Output -- 107 ---------------------- 108 109 procedure Error_Msg_Output (Msg : String; Info : Boolean) is 110 Use_Second_File : Boolean := False; 111 Use_Second_Unit : Boolean := False; 112 Use_Second_Nat : Boolean := False; 113 Warning : Boolean := False; 114 115 begin 116 if Warnings_Detected + Errors_Detected > Maximum_Messages then 117 Write_Str ("error: maximum errors exceeded"); 118 Write_Eol; 119 return; 120 end if; 121 122 -- First, check for warnings 123 124 for J in Msg'Range loop 125 if Msg (J) = '?' then 126 Warning := True; 127 exit; 128 end if; 129 end loop; 130 131 if Warning then 132 Write_Str ("warning: "); 133 elsif Info then 134 if not Info_Prefix_Suppress then 135 Write_Str ("info: "); 136 end if; 137 else 138 Write_Str ("error: "); 139 end if; 140 141 for J in Msg'Range loop 142 if Msg (J) = '%' then 143 Get_Name_String (Error_Msg_Name_1); 144 Write_Char ('"'); 145 Write_Str (Name_Buffer (1 .. Name_Len)); 146 Write_Char ('"'); 147 148 elsif Msg (J) = '{' then 149 if Use_Second_File then 150 Get_Name_String (Error_Msg_File_2); 151 else 152 Use_Second_File := True; 153 Get_Name_String (Error_Msg_File_1); 154 end if; 155 156 Write_Char ('"'); 157 Write_Str (Name_Buffer (1 .. Name_Len)); 158 Write_Char ('"'); 159 160 elsif Msg (J) = '$' then 161 Write_Char ('"'); 162 163 if Use_Second_Unit then 164 Write_Unit_Name (Error_Msg_Unit_2); 165 else 166 Use_Second_Unit := True; 167 Write_Unit_Name (Error_Msg_Unit_1); 168 end if; 169 170 Write_Char ('"'); 171 172 elsif Msg (J) = '#' then 173 if Use_Second_Nat then 174 Write_Int (Error_Msg_Nat_2); 175 else 176 Use_Second_Nat := True; 177 Write_Int (Error_Msg_Nat_1); 178 end if; 179 180 elsif Msg (J) /= '?' then 181 Write_Char (Msg (J)); 182 end if; 183 end loop; 184 185 Write_Eol; 186 end Error_Msg_Output; 187 188 ---------------------- 189 -- Finalize_Binderr -- 190 ---------------------- 191 192 procedure Finalize_Binderr is 193 begin 194 -- Message giving number of errors detected (verbose mode only) 195 196 if Verbose_Mode then 197 Write_Eol; 198 199 if Errors_Detected = 0 then 200 Write_Str ("No errors"); 201 202 elsif Errors_Detected = 1 then 203 Write_Str ("1 error"); 204 205 else 206 Write_Int (Errors_Detected); 207 Write_Str (" errors"); 208 end if; 209 210 if Warnings_Detected = 1 then 211 Write_Str (", 1 warning"); 212 213 elsif Warnings_Detected > 1 then 214 Write_Str (", "); 215 Write_Int (Warnings_Detected); 216 Write_Str (" warnings"); 217 end if; 218 219 Write_Eol; 220 end if; 221 end Finalize_Binderr; 222 223 ------------------------ 224 -- Initialize_Binderr -- 225 ------------------------ 226 227 procedure Initialize_Binderr is 228 begin 229 Errors_Detected := 0; 230 Warnings_Detected := 0; 231 end Initialize_Binderr; 232 233end Binderr; 234