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
;