1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 Warnings_Detected + Errors_Detected > Maximum_Errors then
68 raise Unrecoverable_Error;
77 procedure Error_Msg_Info (Msg : String) is
79 if Brief_Output or else (not Verbose_Mode) then
81 Error_Msg_Output (Msg, Info => True);
86 Error_Msg_Output (Msg, Info => True);
91 ----------------------
92 -- Error_Msg_Output --
93 ----------------------
95 procedure Error_Msg_Output (Msg : String; Info : Boolean) is
96 Use_Second_File : Boolean := False;
97 Use_Second_Unit : Boolean := False;
98 Use_Second_Nat : Boolean := False;
99 Warning : Boolean := False;
102 if Warnings_Detected + Errors_Detected > Maximum_Errors then
103 Write_Str ("error: maximum errors exceeded");
108 -- First, check for warnings
110 for J in Msg'Range loop
111 if Msg (J) = '?' then
118 Write_Str ("warning: ");
120 if not Info_Prefix_Suppress then
121 Write_Str ("info: ");
124 Write_Str ("error: ");
127 for J in Msg'Range loop
128 if Msg (J) = '%' then
129 Get_Name_String (Error_Msg_Name_1);
131 Write_Str (Name_Buffer (1 .. Name_Len));
134 elsif Msg (J) = '{' then
135 if Use_Second_File then
136 Get_Name_String (Error_Msg_File_2);
138 Use_Second_File := True;
139 Get_Name_String (Error_Msg_File_1);
143 Write_Str (Name_Buffer (1 .. Name_Len));
146 elsif Msg (J) = '$' then
149 if Use_Second_Unit then
150 Write_Unit_Name (Error_Msg_Unit_2);
152 Use_Second_Unit := True;
153 Write_Unit_Name (Error_Msg_Unit_1);
158 elsif Msg (J) = '#' then
159 if Use_Second_Nat then
160 Write_Int (Error_Msg_Nat_2);
162 Use_Second_Nat := True;
163 Write_Int (Error_Msg_Nat_1);
166 elsif Msg (J) /= '?' then
167 Write_Char (Msg (J));
172 end Error_Msg_Output;
174 ----------------------
175 -- Finalize_Binderr --
176 ----------------------
178 procedure Finalize_Binderr is
180 -- Message giving number of errors detected (verbose mode only)
185 if Errors_Detected = 0 then
186 Write_Str ("No errors");
188 elsif Errors_Detected = 1 then
189 Write_Str ("1 error");
192 Write_Int (Errors_Detected);
193 Write_Str (" errors");
196 if Warnings_Detected = 1 then
197 Write_Str (", 1 warning");
199 elsif Warnings_Detected > 1 then
201 Write_Int (Warnings_Detected);
202 Write_Str (" warnings");
207 end Finalize_Binderr;
209 ------------------------
210 -- Initialize_Binderr --
211 ------------------------
213 procedure Initialize_Binderr is
215 Errors_Detected := 0;
216 Warnings_Detected := 0;
217 end Initialize_Binderr;