1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Butil; use Butil;
29 with Namet; use Namet;
31 with Output; use Output;
33 package body Binderr is
39 procedure Error_Msg (Msg : String) is
41 if Msg (Msg'First) = '?' then
42 if Warning_Mode = Suppress then
46 if Warning_Mode = Treat_As_Error then
47 Errors_Detected := Errors_Detected + 1;
49 Warnings_Detected := Warnings_Detected + 1;
53 Errors_Detected := Errors_Detected + 1;
56 if Brief_Output or else (not Verbose_Mode) then
58 Error_Msg_Output (Msg, Info => False);
63 if Errors_Detected + Warnings_Detected = 0 then
67 Error_Msg_Output (Msg, Info => False);
70 if Warnings_Detected + Errors_Detected > Maximum_Errors then
71 raise Unrecoverable_Error;
80 procedure Error_Msg_Info (Msg : String) is
82 if Brief_Output or else (not Verbose_Mode) then
84 Error_Msg_Output (Msg, Info => True);
89 Error_Msg_Output (Msg, Info => True);
94 ----------------------
95 -- Error_Msg_Output --
96 ----------------------
98 procedure Error_Msg_Output (Msg : String; Info : Boolean) is
99 Use_Second_Name : 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 I in Msg'Range loop
119 if Msg (I) = '%' 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 (I) = '&' 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 (I) /= '?' then
145 Write_Char (Msg (I));
150 end Error_Msg_Output;
152 ----------------------
153 -- Finalize_Binderr --
154 ----------------------
156 procedure Finalize_Binderr is
158 -- Message giving number of errors detected (verbose mode only)
163 if Errors_Detected = 0 then
164 Write_Str ("No errors");
166 elsif Errors_Detected = 1 then
167 Write_Str ("1 error");
170 Write_Int (Errors_Detected);
171 Write_Str (" errors");
174 if Warnings_Detected = 1 then
175 Write_Str (", 1 warning");
177 elsif Warnings_Detected > 1 then
179 Write_Int (Warnings_Detected);
180 Write_Str (" warnings");
185 end Finalize_Binderr;
187 ------------------------
188 -- Initialize_Binderr --
189 ------------------------
191 procedure Initialize_Binderr is
193 Errors_Detected := 0;
194 Warnings_Detected := 0;
195 end Initialize_Binderr;