1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2002 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 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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Butil; use Butil;
28 with Namet; use Namet;
30 with Output; use Output;
32 package body Binderr is
38 procedure Error_Msg (Msg : String) is
40 if Msg (Msg'First) = '?' then
41 if Warning_Mode = Suppress then
45 if Warning_Mode = Treat_As_Error then
46 Errors_Detected := Errors_Detected + 1;
48 Warnings_Detected := Warnings_Detected + 1;
52 Errors_Detected := Errors_Detected + 1;
55 if Brief_Output or else (not Verbose_Mode) then
57 Error_Msg_Output (Msg, Info => False);
62 if Errors_Detected + Warnings_Detected = 0 then
66 Error_Msg_Output (Msg, Info => False);
69 if Warnings_Detected + Errors_Detected > Maximum_Errors then
70 raise Unrecoverable_Error;
79 procedure Error_Msg_Info (Msg : String) is
81 if Brief_Output or else (not Verbose_Mode) then
83 Error_Msg_Output (Msg, Info => True);
88 Error_Msg_Output (Msg, Info => True);
93 ----------------------
94 -- Error_Msg_Output --
95 ----------------------
97 procedure Error_Msg_Output (Msg : String; Info : Boolean) is
98 Use_Second_Name : Boolean := False;
99 Use_Second_Nat : Boolean := False;
102 if Warnings_Detected + Errors_Detected > Maximum_Errors then
103 Write_Str ("error: maximum errors exceeded");
108 if Msg (Msg'First) = '?' then
109 Write_Str ("warning: ");
111 if not Info_Prefix_Suppress then
112 Write_Str ("info: ");
115 Write_Str ("error: ");
118 for J in Msg'Range loop
119 if Msg (J) = '%' then
121 if Use_Second_Name then
122 Get_Name_String (Error_Msg_Name_2);
124 Use_Second_Name := True;
125 Get_Name_String (Error_Msg_Name_1);
129 Write_Str (Name_Buffer (1 .. Name_Len));
132 elsif Msg (J) = '&' then
135 if Use_Second_Name then
136 Write_Unit_Name (Error_Msg_Name_2);
138 Use_Second_Name := True;
139 Write_Unit_Name (Error_Msg_Name_1);
144 elsif Msg (J) = '#' then
145 if Use_Second_Nat then
146 Write_Int (Error_Msg_Nat_2);
148 Use_Second_Nat := True;
149 Write_Int (Error_Msg_Nat_1);
152 elsif Msg (J) /= '?' then
153 Write_Char (Msg (J));
158 end Error_Msg_Output;
160 ----------------------
161 -- Finalize_Binderr --
162 ----------------------
164 procedure Finalize_Binderr is
166 -- Message giving number of errors detected (verbose mode only)
171 if Errors_Detected = 0 then
172 Write_Str ("No errors");
174 elsif Errors_Detected = 1 then
175 Write_Str ("1 error");
178 Write_Int (Errors_Detected);
179 Write_Str (" errors");
182 if Warnings_Detected = 1 then
183 Write_Str (", 1 warning");
185 elsif Warnings_Detected > 1 then
187 Write_Int (Warnings_Detected);
188 Write_Str (" warnings");
193 end Finalize_Binderr;
195 ------------------------
196 -- Initialize_Binderr --
197 ------------------------
199 procedure Initialize_Binderr is
201 Errors_Detected := 0;
202 Warnings_Detected := 0;
203 end Initialize_Binderr;