|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- B I N D E R R --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 with Butil; use Butil;
|
|
|
27 with Opt; use Opt;
|
|
|
28 with Output; use Output;
|
|
|
29
|
|
|
30 package body Binderr is
|
|
|
31
|
|
|
32 ---------------
|
|
|
33 -- Error_Msg --
|
|
|
34 ---------------
|
|
|
35
|
|
|
36 procedure Error_Msg (Msg : String) is
|
|
|
37 begin
|
|
|
38 if Msg (Msg'First) = '?' then
|
|
|
39 if Warning_Mode = Suppress then
|
|
|
40 return;
|
|
|
41 end if;
|
|
|
42
|
|
|
43 if Warning_Mode = Treat_As_Error then
|
|
|
44 Errors_Detected := Errors_Detected + 1;
|
|
|
45 else
|
|
|
46 Warnings_Detected := Warnings_Detected + 1;
|
|
|
47 end if;
|
|
|
48
|
|
|
49 else
|
|
|
50 Errors_Detected := Errors_Detected + 1;
|
|
|
51 end if;
|
|
|
52
|
|
|
53 if Brief_Output or else (not Verbose_Mode) then
|
|
|
54 Set_Standard_Error;
|
|
|
55 Error_Msg_Output (Msg, Info => False);
|
|
|
56 Set_Standard_Output;
|
|
|
57 end if;
|
|
|
58
|
|
|
59 if Verbose_Mode then
|
|
|
60 if Errors_Detected + Warnings_Detected = 0 then
|
|
|
61 Write_Eol;
|
|
|
62 end if;
|
|
|
63
|
|
|
64 Error_Msg_Output (Msg, Info => False);
|
|
|
65 end if;
|
|
|
66
|
|
|
67 -- If too many warnings print message and then turn off warnings
|
|
|
68
|
|
|
69 if Warnings_Detected = Maximum_Messages then
|
|
|
70 Set_Standard_Error;
|
|
|
71 Write_Line ("maximum number of warnings reached");
|
|
|
72 Write_Line ("further warnings will be suppressed");
|
|
|
73 Set_Standard_Output;
|
|
|
74 Warning_Mode := Suppress;
|
|
|
75 end if;
|
|
|
76
|
|
|
77 -- If too many errors print message and give fatal error
|
|
|
78
|
|
|
79 if Errors_Detected = Maximum_Messages then
|
|
|
80 Set_Standard_Error;
|
|
|
81 Write_Line ("fatal error: maximum number of errors exceeded");
|
|
|
82 Set_Standard_Output;
|
|
|
83 raise Unrecoverable_Error;
|
|
|
84 end if;
|
|
|
85 end Error_Msg;
|
|
|
86
|
|
|
87 --------------------
|
|
|
88 -- Error_Msg_Info --
|
|
|
89 --------------------
|
|
|
90
|
|
|
91 procedure Error_Msg_Info (Msg : String) is
|
|
|
92 begin
|
|
|
93 if Brief_Output or else (not Verbose_Mode) then
|
|
|
94 Set_Standard_Error;
|
|
|
95 Error_Msg_Output (Msg, Info => True);
|
|
|
96 Set_Standard_Output;
|
|
|
97 end if;
|
|
|
98
|
|
|
99 if Verbose_Mode then
|
|
|
100 Error_Msg_Output (Msg, Info => True);
|
|
|
101 end if;
|
|
|
102
|
|
|
103 end Error_Msg_Info;
|
|
|
104
|
|
|
105 ----------------------
|
|
|
106 -- Error_Msg_Output --
|
|
|
107 ----------------------
|
|
|
108
|
|
|
109 procedure Error_Msg_Output (Msg : String; Info : Boolean) is
|
|
|
110 Use_Second_File : Boolean := False;
|
|
|
111 Use_Second_Unit : Boolean := False;
|
|
|
112 Use_Second_Nat : Boolean := False;
|
|
|
113 Warning : Boolean := False;
|
|
|
114
|
|
|
115 begin
|
|
|
116 if Warnings_Detected + Errors_Detected > Maximum_Messages then
|
|
|
117 Write_Str ("error: maximum errors exceeded");
|
|
|
118 Write_Eol;
|
|
|
119 return;
|
|
|
120 end if;
|
|
|
121
|
|
|
122 -- First, check for warnings
|
|
|
123
|
|
|
124 for J in Msg'Range loop
|
|
|
125 if Msg (J) = '?' then
|
|
|
126 Warning := True;
|
|
|
127 exit;
|
|
|
128 end if;
|
|
|
129 end loop;
|
|
|
130
|
|
|
131 if Warning then
|
|
|
132 Write_Str ("warning: ");
|
|
|
133 elsif Info then
|
|
|
134 if not Info_Prefix_Suppress then
|
|
|
135 Write_Str ("info: ");
|
|
|
136 end if;
|
|
|
137 else
|
|
|
138 Write_Str ("error: ");
|
|
|
139 end if;
|
|
|
140
|
|
|
141 for J in Msg'Range loop
|
|
|
142 if Msg (J) = '%' then
|
|
|
143 Get_Name_String (Error_Msg_Name_1);
|
|
|
144 Write_Char ('"');
|
|
|
145 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
146 Write_Char ('"');
|
|
|
147
|
|
|
148 elsif Msg (J) = '{' then
|
|
|
149 if Use_Second_File then
|
|
|
150 Get_Name_String (Error_Msg_File_2);
|
|
|
151 else
|
|
|
152 Use_Second_File := True;
|
|
|
153 Get_Name_String (Error_Msg_File_1);
|
|
|
154 end if;
|
|
|
155
|
|
|
156 Write_Char ('"');
|
|
|
157 Write_Str (Name_Buffer (1 .. Name_Len));
|
|
|
158 Write_Char ('"');
|
|
|
159
|
|
|
160 elsif Msg (J) = '$' then
|
|
|
161 Write_Char ('"');
|
|
|
162
|
|
|
163 if Use_Second_Unit then
|
|
|
164 Write_Unit_Name (Error_Msg_Unit_2);
|
|
|
165 else
|
|
|
166 Use_Second_Unit := True;
|
|
|
167 Write_Unit_Name (Error_Msg_Unit_1);
|
|
|
168 end if;
|
|
|
169
|
|
|
170 Write_Char ('"');
|
|
|
171
|
|
|
172 elsif Msg (J) = '#' then
|
|
|
173 if Use_Second_Nat then
|
|
|
174 Write_Int (Error_Msg_Nat_2);
|
|
|
175 else
|
|
|
176 Use_Second_Nat := True;
|
|
|
177 Write_Int (Error_Msg_Nat_1);
|
|
|
178 end if;
|
|
|
179
|
|
|
180 elsif Msg (J) /= '?' then
|
|
|
181 Write_Char (Msg (J));
|
|
|
182 end if;
|
|
|
183 end loop;
|
|
|
184
|
|
|
185 Write_Eol;
|
|
|
186 end Error_Msg_Output;
|
|
|
187
|
|
|
188 ----------------------
|
|
|
189 -- Finalize_Binderr --
|
|
|
190 ----------------------
|
|
|
191
|
|
|
192 procedure Finalize_Binderr is
|
|
|
193 begin
|
|
|
194 -- Message giving number of errors detected (verbose mode only)
|
|
|
195
|
|
|
196 if Verbose_Mode then
|
|
|
197 Write_Eol;
|
|
|
198
|
|
|
199 if Errors_Detected = 0 then
|
|
|
200 Write_Str ("No errors");
|
|
|
201
|
|
|
202 elsif Errors_Detected = 1 then
|
|
|
203 Write_Str ("1 error");
|
|
|
204
|
|
|
205 else
|
|
|
206 Write_Int (Errors_Detected);
|
|
|
207 Write_Str (" errors");
|
|
|
208 end if;
|
|
|
209
|
|
|
210 if Warnings_Detected = 1 then
|
|
|
211 Write_Str (", 1 warning");
|
|
|
212
|
|
|
213 elsif Warnings_Detected > 1 then
|
|
|
214 Write_Str (", ");
|
|
|
215 Write_Int (Warnings_Detected);
|
|
|
216 Write_Str (" warnings");
|
|
|
217 end if;
|
|
|
218
|
|
|
219 Write_Eol;
|
|
|
220 end if;
|
|
|
221 end Finalize_Binderr;
|
|
|
222
|
|
|
223 ------------------------
|
|
|
224 -- Initialize_Binderr --
|
|
|
225 ------------------------
|
|
|
226
|
|
|
227 procedure Initialize_Binderr is
|
|
|
228 begin
|
|
|
229 Errors_Detected := 0;
|
|
|
230 Warnings_Detected := 0;
|
|
|
231 end Initialize_Binderr;
|
|
|
232
|
|
|
233 end Binderr;
|
