1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Butil; use Butil;
28 with Output; use Output;
30 package body Binderr is
36 procedure Error_Msg (Msg : String) is
38 if Msg (Msg'First) = '?' then
39 if Warning_Mode = Suppress then
43 if Warning_Mode = Treat_As_Error then
44 Errors_Detected := Errors_Detected + 1;
46 Warnings_Detected := Warnings_Detected + 1;
50 Errors_Detected := Errors_Detected + 1;
53 if Brief_Output or else (not Verbose_Mode) then
55 Error_Msg_Output (Msg, Info => False);
60 if Errors_Detected + Warnings_Detected = 0 then
64 Error_Msg_Output (Msg, Info => False);
67 -- If too many warnings print message and then turn off warnings
69 if Warnings_Detected = Maximum_Messages then
71 Write_Line ("maximum number of warnings reached");
72 Write_Line ("further warnings will be suppressed");
74 Warning_Mode := Suppress;
77 -- If too many errors print message and give fatal error
79 if Errors_Detected = Maximum_Messages then
81 Write_Line ("fatal error: maximum number of errors exceeded");
83 raise Unrecoverable_Error;
91 procedure Error_Msg_Info (Msg : String) is
93 if Brief_Output or else (not Verbose_Mode) then
95 Error_Msg_Output (Msg, Info => True);
100 Error_Msg_Output (Msg, Info => True);
105 ----------------------
106 -- Error_Msg_Output --
107 ----------------------
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;
116 if Warnings_Detected + Errors_Detected > Maximum_Messages then
117 Write_Str ("error: maximum errors exceeded");
122 -- First, check for warnings
124 for J in Msg'Range loop
125 if Msg (J) = '?' then
132 Write_Str ("warning: ");
134 if not Info_Prefix_Suppress then
135 Write_Str ("info: ");
138 Write_Str ("error: ");
141 for J in Msg'Range loop
142 if Msg (J) = '%' then
143 Get_Name_String (Error_Msg_Name_1);
145 Write_Str (Name_Buffer (1 .. Name_Len));
148 elsif Msg (J) = '{' then
149 if Use_Second_File then
150 Get_Name_String (Error_Msg_File_2);
152 Use_Second_File := True;
153 Get_Name_String (Error_Msg_File_1);
157 Write_Str (Name_Buffer (1 .. Name_Len));
160 elsif Msg (J) = '$' then
163 if Use_Second_Unit then
164 Write_Unit_Name (Error_Msg_Unit_2);
166 Use_Second_Unit := True;
167 Write_Unit_Name (Error_Msg_Unit_1);
172 elsif Msg (J) = '#' then
173 if Use_Second_Nat then
174 Write_Int (Error_Msg_Nat_2);
176 Use_Second_Nat := True;
177 Write_Int (Error_Msg_Nat_1);
180 elsif Msg (J) /= '?' then
181 Write_Char (Msg (J));
186 end Error_Msg_Output;
188 ----------------------
189 -- Finalize_Binderr --
190 ----------------------
192 procedure Finalize_Binderr is
194 -- Message giving number of errors detected (verbose mode only)
199 if Errors_Detected = 0 then
200 Write_Str ("No errors");
202 elsif Errors_Detected = 1 then
203 Write_Str ("1 error");
206 Write_Int (Errors_Detected);
207 Write_Str (" errors");
210 if Warnings_Detected = 1 then
211 Write_Str (", 1 warning");
213 elsif Warnings_Detected > 1 then
215 Write_Int (Warnings_Detected);
216 Write_Str (" warnings");
221 end Finalize_Binderr;
223 ------------------------
224 -- Initialize_Binderr --
225 ------------------------
227 procedure Initialize_Binderr is
229 Errors_Detected := 0;
230 Warnings_Detected := 0;
231 end Initialize_Binderr;