1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Butil; use Butil;
30 with Namet; use Namet;
32 with Output; use Output;
34 package body Binderr is
40 procedure Error_Msg (Msg : String) is
42 if Msg (Msg'First) = '?' then
43 if Warning_Mode = Suppress then
47 if Warning_Mode = Treat_As_Error then
48 Errors_Detected := Errors_Detected + 1;
50 Warnings_Detected := Warnings_Detected + 1;
54 Errors_Detected := Errors_Detected + 1;
57 if Brief_Output or else (not Verbose_Mode) then
59 Error_Msg_Output (Msg, Info => False);
64 if Errors_Detected + Warnings_Detected = 0 then
68 Error_Msg_Output (Msg, Info => False);
71 if Warnings_Detected + Errors_Detected > Maximum_Errors then
72 raise Unrecoverable_Error;
81 procedure Error_Msg_Info (Msg : String) is
83 if Brief_Output or else (not Verbose_Mode) then
85 Error_Msg_Output (Msg, Info => True);
90 Error_Msg_Output (Msg, Info => True);
95 ----------------------
96 -- Error_Msg_Output --
97 ----------------------
99 procedure Error_Msg_Output (Msg : String; Info : Boolean) is
100 Use_Second_Name : Boolean := False;
103 if Warnings_Detected + Errors_Detected > Maximum_Errors then
104 Write_Str ("error: maximum errors exceeded");
109 if Msg (Msg'First) = '?' then
110 Write_Str ("warning: ");
112 if not Info_Prefix_Suppress then
113 Write_Str ("info: ");
116 Write_Str ("error: ");
119 for I in Msg'Range loop
120 if Msg (I) = '%' then
122 if Use_Second_Name then
123 Get_Name_String (Error_Msg_Name_2);
125 Use_Second_Name := True;
126 Get_Name_String (Error_Msg_Name_1);
130 Write_Str (Name_Buffer (1 .. Name_Len));
133 elsif Msg (I) = '&' then
136 if Use_Second_Name then
137 Write_Unit_Name (Error_Msg_Name_2);
139 Use_Second_Name := True;
140 Write_Unit_Name (Error_Msg_Name_1);
145 elsif Msg (I) /= '?' then
146 Write_Char (Msg (I));
151 end Error_Msg_Output;
153 ----------------------
154 -- Finalize_Binderr --
155 ----------------------
157 procedure Finalize_Binderr is
159 -- Message giving number of errors detected (verbose mode only)
164 if Errors_Detected = 0 then
165 Write_Str ("No errors");
167 elsif Errors_Detected = 1 then
168 Write_Str ("1 error");
171 Write_Int (Errors_Detected);
172 Write_Str (" errors");
175 if Warnings_Detected = 1 then
176 Write_Str (", 1 warning");
178 elsif Warnings_Detected > 1 then
180 Write_Int (Warnings_Detected);
181 Write_Str (" warnings");
186 end Finalize_Binderr;
188 ------------------------
189 -- Initialize_Binderr --
190 ------------------------
192 procedure Initialize_Binderr is
194 Errors_Detected := 0;
195 Warnings_Detected := 0;
196 end Initialize_Binderr;