]>
Commit | Line | Data |
---|---|---|
6de9cd9a | 1 | /* Handle errors. |
8f0d39a8 FXC |
2 | Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software |
3 | Foundation, Inc. | |
6de9cd9a DN |
4 | Contributed by Andy Vaught & Niels Kristian Bech Jensen |
5 | ||
9fc4d79b | 6 | This file is part of GCC. |
6de9cd9a | 7 | |
9fc4d79b TS |
8 | GCC is free software; you can redistribute it and/or modify it under |
9 | the terms of the GNU General Public License as published by the Free | |
10 | Software Foundation; either version 2, or (at your option) any later | |
11 | version. | |
6de9cd9a | 12 | |
9fc4d79b TS |
13 | GCC is distributed in the hope that it will be useful, but WITHOUT ANY |
14 | WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 | for more details. | |
6de9cd9a DN |
17 | |
18 | You should have received a copy of the GNU General Public License | |
9fc4d79b | 19 | along with GCC; see the file COPYING. If not, write to the Free |
ab57747b KC |
20 | Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA |
21 | 02110-1301, USA. */ | |
6de9cd9a DN |
22 | |
23 | /* Handle the inevitable errors. A major catch here is that things | |
24 | flagged as errors in one match subroutine can conceivably be legal | |
25 | elsewhere. This means that error messages are recorded and saved | |
26 | for possible use later. If a line does not match a legal | |
27 | construction, then the saved error message is reported. */ | |
28 | ||
29 | #include "config.h" | |
30 | #include "system.h" | |
6de9cd9a DN |
31 | #include "flags.h" |
32 | #include "gfortran.h" | |
33 | ||
34 | int gfc_suppress_error = 0; | |
35 | ||
d71b89ca | 36 | static int terminal_width, buffer_flag, errors, warnings; |
6de9cd9a | 37 | |
d71b89ca | 38 | static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer; |
6de9cd9a DN |
39 | |
40 | ||
41 | /* Per-file error initialization. */ | |
42 | ||
43 | void | |
44 | gfc_error_init_1 (void) | |
45 | { | |
1f05db63 | 46 | terminal_width = gfc_terminal_width (); |
6de9cd9a DN |
47 | errors = 0; |
48 | warnings = 0; | |
49 | buffer_flag = 0; | |
50 | } | |
51 | ||
52 | ||
53 | /* Set the flag for buffering errors or not. */ | |
54 | ||
55 | void | |
56 | gfc_buffer_error (int flag) | |
57 | { | |
6de9cd9a DN |
58 | buffer_flag = flag; |
59 | } | |
60 | ||
61 | ||
62 | /* Add a single character to the error buffer or output depending on | |
63 | buffer_flag. */ | |
64 | ||
65 | static void | |
66 | error_char (char c) | |
67 | { | |
6de9cd9a DN |
68 | if (buffer_flag) |
69 | { | |
d71b89ca | 70 | if (cur_error_buffer->index >= cur_error_buffer->allocated) |
6de9cd9a | 71 | { |
d71b89ca JJ |
72 | cur_error_buffer->allocated = |
73 | cur_error_buffer->allocated | |
74 | ? cur_error_buffer->allocated * 2 : 1000; | |
75 | cur_error_buffer->message | |
76 | = xrealloc (cur_error_buffer->message, | |
77 | cur_error_buffer->allocated); | |
6de9cd9a | 78 | } |
d71b89ca | 79 | cur_error_buffer->message[cur_error_buffer->index++] = c; |
6de9cd9a DN |
80 | } |
81 | else | |
82 | { | |
83 | if (c != 0) | |
dfbb4318 TS |
84 | { |
85 | /* We build up complete lines before handing things | |
86 | over to the library in order to speed up error printing. */ | |
d71b89ca JJ |
87 | static char *line; |
88 | static size_t allocated = 0, index = 0; | |
dfbb4318 | 89 | |
d71b89ca JJ |
90 | if (index + 1 >= allocated) |
91 | { | |
92 | allocated = allocated ? allocated * 2 : 1000; | |
93 | line = xrealloc (line, allocated); | |
94 | } | |
dfbb4318 | 95 | line[index++] = c; |
d71b89ca | 96 | if (c == '\n') |
dfbb4318 TS |
97 | { |
98 | line[index] = '\0'; | |
99 | fputs (line, stderr); | |
100 | index = 0; | |
101 | } | |
102 | } | |
6de9cd9a DN |
103 | } |
104 | } | |
105 | ||
106 | ||
107 | /* Copy a string to wherever it needs to go. */ | |
108 | ||
109 | static void | |
110 | error_string (const char *p) | |
111 | { | |
6de9cd9a DN |
112 | while (*p) |
113 | error_char (*p++); | |
114 | } | |
115 | ||
116 | ||
12c78966 BM |
117 | /* Print a formatted integer to the error buffer or output. */ |
118 | ||
119 | #define IBUF_LEN 30 | |
120 | ||
121 | static void | |
122 | error_integer (int i) | |
123 | { | |
124 | char *p, int_buf[IBUF_LEN]; | |
125 | ||
126 | if (i < 0) | |
127 | { | |
128 | i = -i; | |
129 | error_char ('-'); | |
130 | } | |
131 | ||
132 | p = int_buf + IBUF_LEN - 1; | |
133 | *p-- = '\0'; | |
134 | ||
135 | if (i == 0) | |
136 | *p-- = '0'; | |
137 | ||
138 | while (i > 0) | |
139 | { | |
140 | *p-- = i % 10 + '0'; | |
141 | i = i / 10; | |
142 | } | |
143 | ||
144 | error_string (p + 1); | |
145 | } | |
146 | ||
147 | ||
148 | /* Show the file, where it was included, and the source line, give a | |
6de9cd9a DN |
149 | locus. Calls error_printf() recursively, but the recursion is at |
150 | most one level deep. */ | |
151 | ||
0ce0154c | 152 | static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); |
6de9cd9a DN |
153 | |
154 | static void | |
12c78966 | 155 | show_locus (locus * loc, int c1, int c2) |
6de9cd9a | 156 | { |
d4fa05b9 | 157 | gfc_linebuf *lb; |
6de9cd9a DN |
158 | gfc_file *f; |
159 | char c, *p; | |
12c78966 | 160 | int i, m, offset, cmax; |
6de9cd9a DN |
161 | |
162 | /* TODO: Either limit the total length and number of included files | |
163 | displayed or add buffering of arbitrary number of characters in | |
164 | error messages. */ | |
6de9cd9a | 165 | |
12c78966 BM |
166 | /* Write out the error header line, giving the source file and error |
167 | location (in GNU standard "[file]:[line].[column]:" format), | |
168 | followed by an "included by" stack and a blank line. This header | |
169 | format is matched by a testsuite parser defined in | |
170 | lib/gfortran-dg.exp. */ | |
171 | ||
d4fa05b9 TS |
172 | lb = loc->lb; |
173 | f = lb->file; | |
12c78966 BM |
174 | |
175 | error_string (f->filename); | |
176 | error_char (':'); | |
177 | ||
c8cc8542 | 178 | #ifdef USE_MAPPED_LOCATION |
12c78966 | 179 | error_integer (LOCATION_LINE (lb->location)); |
c8cc8542 | 180 | #else |
12c78966 | 181 | error_integer (lb->linenum); |
c8cc8542 | 182 | #endif |
12c78966 BM |
183 | |
184 | if ((c1 > 0) || (c2 > 0)) | |
185 | error_char ('.'); | |
186 | ||
187 | if (c1 > 0) | |
188 | error_integer (c1); | |
189 | ||
190 | if ((c1 > 0) && (c2 > 0)) | |
191 | error_char ('-'); | |
192 | ||
193 | if (c2 > 0) | |
194 | error_integer (c2); | |
195 | ||
196 | error_char (':'); | |
197 | error_char ('\n'); | |
d4fa05b9 TS |
198 | |
199 | for (;;) | |
6de9cd9a | 200 | { |
d4fa05b9 TS |
201 | i = f->inclusion_line; |
202 | ||
6de9cd9a | 203 | f = f->included_by; |
d4fa05b9 TS |
204 | if (f == NULL) break; |
205 | ||
12c78966 | 206 | error_printf (" Included at %s:%d:", f->filename, i); |
6de9cd9a DN |
207 | } |
208 | ||
12c78966 BM |
209 | error_char ('\n'); |
210 | ||
211 | /* Calculate an appropriate horizontal offset of the source line in | |
212 | order to get the error locus within the visible portion of the | |
213 | line. Note that if the margin of 5 here is changed, the | |
214 | corresponding margin of 10 in show_loci should be changed. */ | |
215 | ||
216 | offset = 0; | |
217 | ||
218 | /* When the loci is not associated with a column, it will have a | |
219 | value of zero. We adjust this to 1 so that it will appear. */ | |
220 | ||
221 | if (c1 == 0) | |
222 | c1 = 1; | |
223 | if (c2 == 0) | |
224 | c2 = 1; | |
225 | ||
226 | /* If the two loci would appear in the same column, we shift | |
227 | '2' one column to the right, so as to print '12' rather than | |
228 | just '1'. We do this here so it will be accounted for in the | |
229 | margin calculations. */ | |
230 | ||
231 | if (c1 == c2) | |
232 | c2 += 1; | |
233 | ||
234 | cmax = (c1 < c2) ? c2 : c1; | |
235 | if (cmax > terminal_width - 5) | |
236 | offset = cmax - terminal_width + 5; | |
237 | ||
238 | /* TODO: Is there a good reason for the following apparently-redundant | |
239 | check, and the similar ones in the single-locus cases below? */ | |
240 | ||
241 | if (offset < 0) | |
242 | offset = 0; | |
243 | ||
6de9cd9a | 244 | /* Show the line itself, taking care not to print more than what can |
12c78966 BM |
245 | show up on the terminal. Tabs are converted to spaces, and |
246 | nonprintable characters are converted to a "\xNN" sequence. */ | |
247 | ||
248 | /* TODO: Although setting i to the terminal width is clever, it fails | |
249 | to work correctly when nonprintable characters exist. A better | |
250 | solution should be found. */ | |
d4fa05b9 TS |
251 | |
252 | p = lb->line + offset; | |
6de9cd9a DN |
253 | i = strlen (p); |
254 | if (i > terminal_width) | |
255 | i = terminal_width - 1; | |
256 | ||
257 | for (; i > 0; i--) | |
258 | { | |
259 | c = *p++; | |
260 | if (c == '\t') | |
261 | c = ' '; | |
262 | ||
263 | if (ISPRINT (c)) | |
264 | error_char (c); | |
265 | else | |
266 | { | |
267 | error_char ('\\'); | |
268 | error_char ('x'); | |
269 | ||
270 | m = ((c >> 4) & 0x0F) + '0'; | |
271 | if (m > '9') | |
272 | m += 'A' - '9' - 1; | |
273 | error_char (m); | |
274 | ||
275 | m = (c & 0x0F) + '0'; | |
276 | if (m > '9') | |
277 | m += 'A' - '9' - 1; | |
278 | error_char (m); | |
279 | } | |
280 | } | |
281 | ||
282 | error_char ('\n'); | |
12c78966 BM |
283 | |
284 | /* Show the '1' and/or '2' corresponding to the column of the error | |
285 | locus. Note that a value of -1 for c1 or c2 will simply cause | |
286 | the relevant number not to be printed. */ | |
287 | ||
288 | c1 -= offset; | |
289 | c2 -= offset; | |
290 | ||
291 | for (i = 1; i <= cmax; i++) | |
292 | { | |
293 | if (i == c1) | |
294 | error_char ('1'); | |
295 | else if (i == c2) | |
296 | error_char ('2'); | |
297 | else | |
298 | error_char (' '); | |
299 | } | |
300 | ||
301 | error_char ('\n'); | |
302 | ||
6de9cd9a DN |
303 | } |
304 | ||
305 | ||
306 | /* As part of printing an error, we show the source lines that caused | |
12c78966 BM |
307 | the problem. We show at least one, and possibly two loci; the two |
308 | loci may or may not be on the same source line. */ | |
6de9cd9a DN |
309 | |
310 | static void | |
311 | show_loci (locus * l1, locus * l2) | |
312 | { | |
12c78966 | 313 | int m, c1, c2; |
6de9cd9a | 314 | |
fc29d5c4 | 315 | if (l1 == NULL || l1->lb == NULL) |
6de9cd9a DN |
316 | { |
317 | error_printf ("<During initialization>\n"); | |
318 | return; | |
319 | } | |
320 | ||
12c78966 BM |
321 | /* While calculating parameters for printing the loci, we consider possible |
322 | reasons for printing one per line. If appropriate, print the loci | |
323 | individually; otherwise we print them both on the same line. */ | |
324 | ||
d4fa05b9 | 325 | c1 = l1->nextc - l1->lb->line; |
6de9cd9a | 326 | if (l2 == NULL) |
12c78966 BM |
327 | { |
328 | show_locus (l1, c1, -1); | |
329 | return; | |
330 | } | |
6de9cd9a | 331 | |
d4fa05b9 | 332 | c2 = l2->nextc - l2->lb->line; |
6de9cd9a DN |
333 | |
334 | if (c1 < c2) | |
335 | m = c2 - c1; | |
336 | else | |
337 | m = c1 - c2; | |
338 | ||
12c78966 BM |
339 | /* Note that the margin value of 10 here needs to be less than the |
340 | margin of 5 used in the calculation of offset in show_locus. */ | |
6de9cd9a | 341 | |
d4fa05b9 | 342 | if (l1->lb != l2->lb || m > terminal_width - 10) |
6de9cd9a | 343 | { |
12c78966 BM |
344 | show_locus (l1, c1, -1); |
345 | show_locus (l2, -1, c2); | |
346 | return; | |
6de9cd9a DN |
347 | } |
348 | ||
12c78966 | 349 | show_locus (l1, c1, c2); |
6de9cd9a DN |
350 | |
351 | return; | |
352 | ||
6de9cd9a DN |
353 | } |
354 | ||
355 | ||
356 | /* Workhorse for the error printing subroutines. This subroutine is | |
357 | inspired by g77's error handling and is similar to printf() with | |
358 | the following %-codes: | |
359 | ||
12c78966 | 360 | %c Character, %d or %i Integer, %s String, %% Percent |
6de9cd9a DN |
361 | %L Takes locus argument |
362 | %C Current locus (no argument) | |
363 | ||
364 | If a locus pointer is given, the actual source line is printed out | |
365 | and the column is indicated. Since we want the error message at | |
366 | the bottom of any source file information, we must scan the | |
12c78966 BM |
367 | argument list twice -- once to determine whether the loci are |
368 | present and record this for printing, and once to print the error | |
369 | message after and loci have been printed. A maximum of two locus | |
370 | arguments are permitted. | |
371 | ||
372 | This function is also called (recursively) by show_locus in the | |
373 | case of included files; however, as show_locus does not resupply | |
374 | any loci, the recursion is at most one level deep. */ | |
6de9cd9a | 375 | |
6de9cd9a DN |
376 | #define MAX_ARGS 10 |
377 | ||
0ce0154c | 378 | static void ATTRIBUTE_GCC_GFC(2,0) |
6de9cd9a DN |
379 | error_print (const char *type, const char *format0, va_list argp) |
380 | { | |
9406549c FXC |
381 | enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_CHAR, TYPE_STRING, |
382 | NOTYPE }; | |
383 | struct | |
384 | { | |
385 | int type; | |
386 | int pos; | |
387 | union | |
388 | { | |
389 | int intval; | |
390 | char charval; | |
391 | const char * stringval; | |
392 | } u; | |
393 | } arg[MAX_ARGS], spec[MAX_ARGS]; | |
394 | /* spec is the array of specifiers, in the same order as they | |
395 | appear in the format string. arg is the array of arguments, | |
396 | in the same order as they appear in the va_list. */ | |
397 | ||
398 | char c; | |
399 | int i, n, have_l1, pos, maxpos; | |
6de9cd9a DN |
400 | locus *l1, *l2, *loc; |
401 | const char *format; | |
402 | ||
9406549c | 403 | l1 = l2 = NULL; |
6de9cd9a DN |
404 | |
405 | have_l1 = 0; | |
9406549c FXC |
406 | pos = -1; |
407 | maxpos = -1; | |
6de9cd9a DN |
408 | |
409 | n = 0; | |
410 | format = format0; | |
411 | ||
9406549c FXC |
412 | for (i = 0; i < MAX_ARGS; i++) |
413 | { | |
414 | arg[i].type = NOTYPE; | |
415 | spec[i].pos = -1; | |
416 | } | |
417 | ||
418 | /* First parse the format string for position specifiers. */ | |
6de9cd9a DN |
419 | while (*format) |
420 | { | |
421 | c = *format++; | |
9406549c FXC |
422 | if (c != '%') |
423 | continue; | |
424 | ||
425 | if (*format == '%') | |
426 | continue; | |
427 | ||
428 | if (ISDIGIT (*format)) | |
6de9cd9a | 429 | { |
9406549c FXC |
430 | /* This is a position specifier. For example, the number |
431 | 12 in the format string "%12$d", which specifies the third | |
432 | argument of the va_list, formatted in %d format. | |
433 | For details, see "man 3 printf". */ | |
434 | pos = atoi(format) - 1; | |
435 | gcc_assert (pos >= 0); | |
436 | while (ISDIGIT(*format)) | |
437 | format++; | |
438 | gcc_assert (*format++ == '$'); | |
439 | } | |
440 | else | |
441 | pos++; | |
6de9cd9a | 442 | |
9406549c FXC |
443 | c = *format++; |
444 | ||
445 | if (pos > maxpos) | |
446 | maxpos = pos; | |
447 | ||
448 | switch (c) | |
449 | { | |
450 | case 'C': | |
451 | arg[pos].type = TYPE_CURRENTLOC; | |
452 | break; | |
453 | ||
454 | case 'L': | |
455 | arg[pos].type = TYPE_LOCUS; | |
456 | break; | |
457 | ||
458 | case 'd': | |
459 | case 'i': | |
460 | arg[pos].type = TYPE_INTEGER; | |
461 | break; | |
462 | ||
463 | case 'c': | |
464 | arg[pos].type = TYPE_CHAR; | |
465 | break; | |
466 | ||
467 | case 's': | |
468 | arg[pos].type = TYPE_STRING; | |
469 | break; | |
470 | ||
471 | default: | |
472 | gcc_unreachable (); | |
473 | } | |
6de9cd9a | 474 | |
9406549c FXC |
475 | spec[n++].pos = pos; |
476 | } | |
477 | ||
478 | /* Then convert the values for each %-style argument. */ | |
479 | for (pos = 0; pos <= maxpos; pos++) | |
480 | { | |
481 | gcc_assert (arg[pos].type != NOTYPE); | |
482 | switch (arg[pos].type) | |
483 | { | |
484 | case TYPE_CURRENTLOC: | |
485 | loc = &gfc_current_locus; | |
486 | /* Fall through. */ | |
487 | ||
488 | case TYPE_LOCUS: | |
489 | if (arg[pos].type == TYPE_LOCUS) | |
6de9cd9a | 490 | loc = va_arg (argp, locus *); |
9406549c FXC |
491 | |
492 | if (have_l1) | |
493 | { | |
494 | l2 = loc; | |
495 | arg[pos].u.stringval = "(2)"; | |
496 | } | |
497 | else | |
498 | { | |
499 | l1 = loc; | |
500 | have_l1 = 1; | |
501 | arg[pos].u.stringval = "(1)"; | |
502 | } | |
503 | break; | |
504 | ||
505 | case TYPE_INTEGER: | |
506 | arg[pos].u.intval = va_arg (argp, int); | |
507 | break; | |
508 | ||
509 | case TYPE_CHAR: | |
510 | arg[pos].u.charval = (char) va_arg (argp, int); | |
511 | break; | |
512 | ||
513 | case TYPE_STRING: | |
514 | arg[pos].u.stringval = (const char *) va_arg (argp, char *); | |
515 | break; | |
516 | ||
517 | default: | |
518 | gcc_unreachable (); | |
6de9cd9a DN |
519 | } |
520 | } | |
521 | ||
9406549c FXC |
522 | for (n = 0; spec[n].pos >= 0; n++) |
523 | spec[n].u = arg[spec[n].pos].u; | |
524 | ||
6de9cd9a DN |
525 | /* Show the current loci if we have to. */ |
526 | if (have_l1) | |
527 | show_loci (l1, l2); | |
12c78966 | 528 | |
cb60c134 | 529 | if (*type) |
12c78966 BM |
530 | { |
531 | error_string (type); | |
532 | error_char (' '); | |
533 | } | |
6de9cd9a DN |
534 | |
535 | have_l1 = 0; | |
536 | format = format0; | |
537 | n = 0; | |
538 | ||
539 | for (; *format; format++) | |
540 | { | |
541 | if (*format != '%') | |
542 | { | |
543 | error_char (*format); | |
544 | continue; | |
545 | } | |
546 | ||
547 | format++; | |
9406549c FXC |
548 | if (ISDIGIT(*format)) |
549 | { | |
550 | /* This is a position specifier. See comment above. */ | |
551 | while (ISDIGIT(*format)) | |
70e7f689 | 552 | format++; |
9406549c FXC |
553 | |
554 | /* Skip over the dollar sign. */ | |
555 | format++; | |
556 | } | |
557 | ||
6de9cd9a DN |
558 | switch (*format) |
559 | { | |
560 | case '%': | |
561 | error_char ('%'); | |
562 | break; | |
563 | ||
564 | case 'c': | |
9406549c | 565 | error_char (spec[n++].u.charval); |
6de9cd9a DN |
566 | break; |
567 | ||
568 | case 's': | |
6de9cd9a DN |
569 | case 'C': /* Current locus */ |
570 | case 'L': /* Specified locus */ | |
9406549c | 571 | error_string (spec[n++].u.stringval); |
6de9cd9a | 572 | break; |
12c78966 | 573 | |
9406549c FXC |
574 | case 'd': |
575 | case 'i': | |
576 | error_integer (spec[n++].u.intval); | |
12c78966 | 577 | break; |
6de9cd9a DN |
578 | } |
579 | } | |
580 | ||
581 | error_char ('\n'); | |
582 | } | |
583 | ||
584 | ||
585 | /* Wrapper for error_print(). */ | |
586 | ||
587 | static void | |
31043f6c | 588 | error_printf (const char *nocmsgid, ...) |
6de9cd9a DN |
589 | { |
590 | va_list argp; | |
591 | ||
31043f6c FXC |
592 | va_start (argp, nocmsgid); |
593 | error_print ("", _(nocmsgid), argp); | |
6de9cd9a DN |
594 | va_end (argp); |
595 | } | |
596 | ||
597 | ||
3f139fcf BM |
598 | /* Increment the number of errors, and check whether too many have |
599 | been printed. */ | |
600 | ||
601 | static void | |
602 | gfc_increment_error_count (void) | |
603 | { | |
604 | errors++; | |
605 | if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors)) | |
606 | gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors); | |
607 | } | |
608 | ||
609 | ||
6de9cd9a DN |
610 | /* Issue a warning. */ |
611 | ||
612 | void | |
31043f6c | 613 | gfc_warning (const char *nocmsgid, ...) |
6de9cd9a DN |
614 | { |
615 | va_list argp; | |
616 | ||
617 | if (inhibit_warnings) | |
618 | return; | |
619 | ||
620 | warning_buffer.flag = 1; | |
d71b89ca JJ |
621 | warning_buffer.index = 0; |
622 | cur_error_buffer = &warning_buffer; | |
6de9cd9a | 623 | |
31043f6c | 624 | va_start (argp, nocmsgid); |
3f139fcf BM |
625 | error_print (_("Warning:"), _(nocmsgid), argp); |
626 | va_end (argp); | |
627 | ||
628 | error_char ('\0'); | |
629 | ||
6de9cd9a | 630 | if (buffer_flag == 0) |
f4d4085c | 631 | { |
6de9cd9a | 632 | warnings++; |
f4d4085c | 633 | if (warnings_are_errors) |
3f139fcf | 634 | gfc_increment_error_count(); |
f4d4085c | 635 | } |
6de9cd9a DN |
636 | } |
637 | ||
638 | ||
8f0d39a8 FXC |
639 | /* Whether, for a feature included in a given standard set (GFC_STD_*), |
640 | we should issue an error or a warning, or be quiet. */ | |
641 | ||
642 | notification | |
643 | gfc_notification_std (int std) | |
644 | { | |
645 | bool warning; | |
646 | ||
647 | warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings; | |
648 | if ((gfc_option.allow_std & std) != 0 && !warning) | |
649 | return SILENT; | |
650 | ||
651 | return warning ? WARNING : ERROR; | |
652 | } | |
653 | ||
654 | ||
6de9cd9a DN |
655 | /* Possibly issue a warning/error about use of a nonstandard (or deleted) |
656 | feature. An error/warning will be issued if the currently selected | |
657 | standard does not contain the requested bits. Return FAILURE if | |
e88763d1 | 658 | an error is generated. */ |
6de9cd9a DN |
659 | |
660 | try | |
31043f6c | 661 | gfc_notify_std (int std, const char *nocmsgid, ...) |
6de9cd9a DN |
662 | { |
663 | va_list argp; | |
664 | bool warning; | |
665 | ||
666 | warning = ((gfc_option.warn_std & std) != 0) | |
667 | && !inhibit_warnings; | |
668 | if ((gfc_option.allow_std & std) != 0 | |
669 | && !warning) | |
670 | return SUCCESS; | |
671 | ||
672 | if (gfc_suppress_error) | |
673 | return warning ? SUCCESS : FAILURE; | |
f4d4085c BF |
674 | |
675 | cur_error_buffer = (warning && !warnings_are_errors) | |
676 | ? &warning_buffer : &error_buffer; | |
d71b89ca JJ |
677 | cur_error_buffer->flag = 1; |
678 | cur_error_buffer->index = 0; | |
6de9cd9a | 679 | |
31043f6c | 680 | va_start (argp, nocmsgid); |
6de9cd9a | 681 | if (warning) |
31043f6c | 682 | error_print (_("Warning:"), _(nocmsgid), argp); |
6de9cd9a | 683 | else |
31043f6c | 684 | error_print (_("Error:"), _(nocmsgid), argp); |
6de9cd9a DN |
685 | va_end (argp); |
686 | ||
687 | error_char ('\0'); | |
3f139fcf BM |
688 | |
689 | if (buffer_flag == 0) | |
690 | { | |
691 | if (warning && !warnings_are_errors) | |
692 | warnings++; | |
693 | else | |
694 | gfc_increment_error_count(); | |
695 | } | |
696 | ||
f4d4085c | 697 | return (warning && !warnings_are_errors) ? SUCCESS : FAILURE; |
6de9cd9a DN |
698 | } |
699 | ||
700 | ||
701 | /* Immediate warning (i.e. do not buffer the warning). */ | |
702 | ||
703 | void | |
31043f6c | 704 | gfc_warning_now (const char *nocmsgid, ...) |
6de9cd9a DN |
705 | { |
706 | va_list argp; | |
707 | int i; | |
708 | ||
709 | if (inhibit_warnings) | |
710 | return; | |
711 | ||
712 | i = buffer_flag; | |
713 | buffer_flag = 0; | |
714 | warnings++; | |
f4d4085c | 715 | if (warnings_are_errors) |
3f139fcf | 716 | gfc_increment_error_count(); |
6de9cd9a | 717 | |
31043f6c FXC |
718 | va_start (argp, nocmsgid); |
719 | error_print (_("Warning:"), _(nocmsgid), argp); | |
6de9cd9a DN |
720 | va_end (argp); |
721 | ||
722 | error_char ('\0'); | |
723 | buffer_flag = i; | |
724 | } | |
725 | ||
726 | ||
727 | /* Clear the warning flag. */ | |
728 | ||
729 | void | |
730 | gfc_clear_warning (void) | |
731 | { | |
6de9cd9a DN |
732 | warning_buffer.flag = 0; |
733 | } | |
734 | ||
735 | ||
736 | /* Check to see if any warnings have been saved. | |
737 | If so, print the warning. */ | |
738 | ||
739 | void | |
740 | gfc_warning_check (void) | |
741 | { | |
6de9cd9a DN |
742 | if (warning_buffer.flag) |
743 | { | |
744 | warnings++; | |
d71b89ca JJ |
745 | if (warning_buffer.message != NULL) |
746 | fputs (warning_buffer.message, stderr); | |
6de9cd9a DN |
747 | warning_buffer.flag = 0; |
748 | } | |
749 | } | |
750 | ||
751 | ||
752 | /* Issue an error. */ | |
753 | ||
754 | void | |
31043f6c | 755 | gfc_error (const char *nocmsgid, ...) |
6de9cd9a DN |
756 | { |
757 | va_list argp; | |
758 | ||
759 | if (gfc_suppress_error) | |
760 | return; | |
761 | ||
762 | error_buffer.flag = 1; | |
d71b89ca JJ |
763 | error_buffer.index = 0; |
764 | cur_error_buffer = &error_buffer; | |
6de9cd9a | 765 | |
31043f6c | 766 | va_start (argp, nocmsgid); |
31043f6c | 767 | error_print (_("Error:"), _(nocmsgid), argp); |
6de9cd9a DN |
768 | va_end (argp); |
769 | ||
770 | error_char ('\0'); | |
3f139fcf BM |
771 | |
772 | if (buffer_flag == 0) | |
773 | gfc_increment_error_count(); | |
6de9cd9a DN |
774 | } |
775 | ||
776 | ||
777 | /* Immediate error. */ | |
778 | ||
779 | void | |
31043f6c | 780 | gfc_error_now (const char *nocmsgid, ...) |
6de9cd9a DN |
781 | { |
782 | va_list argp; | |
783 | int i; | |
784 | ||
785 | error_buffer.flag = 1; | |
d71b89ca JJ |
786 | error_buffer.index = 0; |
787 | cur_error_buffer = &error_buffer; | |
6de9cd9a DN |
788 | |
789 | i = buffer_flag; | |
790 | buffer_flag = 0; | |
6de9cd9a | 791 | |
31043f6c FXC |
792 | va_start (argp, nocmsgid); |
793 | error_print (_("Error:"), _(nocmsgid), argp); | |
6de9cd9a DN |
794 | va_end (argp); |
795 | ||
796 | error_char ('\0'); | |
3f139fcf BM |
797 | |
798 | gfc_increment_error_count(); | |
799 | ||
6de9cd9a | 800 | buffer_flag = i; |
b3ae6c0f SK |
801 | |
802 | if (flag_fatal_errors) | |
803 | exit (1); | |
6de9cd9a DN |
804 | } |
805 | ||
806 | ||
807 | /* Fatal error, never returns. */ | |
808 | ||
809 | void | |
31043f6c | 810 | gfc_fatal_error (const char *nocmsgid, ...) |
6de9cd9a DN |
811 | { |
812 | va_list argp; | |
813 | ||
814 | buffer_flag = 0; | |
815 | ||
31043f6c FXC |
816 | va_start (argp, nocmsgid); |
817 | error_print (_("Fatal Error:"), _(nocmsgid), argp); | |
6de9cd9a DN |
818 | va_end (argp); |
819 | ||
820 | exit (3); | |
821 | } | |
822 | ||
823 | ||
824 | /* This shouldn't happen... but sometimes does. */ | |
825 | ||
826 | void | |
827 | gfc_internal_error (const char *format, ...) | |
828 | { | |
829 | va_list argp; | |
830 | ||
831 | buffer_flag = 0; | |
832 | ||
833 | va_start (argp, format); | |
834 | ||
63645982 | 835 | show_loci (&gfc_current_locus, NULL); |
6de9cd9a DN |
836 | error_printf ("Internal Error at (1):"); |
837 | ||
838 | error_print ("", format, argp); | |
839 | va_end (argp); | |
840 | ||
ddaf3b86 | 841 | exit (ICE_EXIT_CODE); |
6de9cd9a DN |
842 | } |
843 | ||
844 | ||
845 | /* Clear the error flag when we start to compile a source line. */ | |
846 | ||
847 | void | |
848 | gfc_clear_error (void) | |
849 | { | |
6de9cd9a DN |
850 | error_buffer.flag = 0; |
851 | } | |
852 | ||
853 | ||
8f81c3c6 PT |
854 | /* Tests the state of error_flag. */ |
855 | ||
856 | int | |
857 | gfc_error_flag_test (void) | |
858 | { | |
859 | return error_buffer.flag; | |
860 | } | |
861 | ||
862 | ||
6de9cd9a DN |
863 | /* Check to see if any errors have been saved. |
864 | If so, print the error. Returns the state of error_flag. */ | |
865 | ||
866 | int | |
867 | gfc_error_check (void) | |
868 | { | |
869 | int rc; | |
870 | ||
871 | rc = error_buffer.flag; | |
872 | ||
873 | if (error_buffer.flag) | |
874 | { | |
d71b89ca JJ |
875 | if (error_buffer.message != NULL) |
876 | fputs (error_buffer.message, stderr); | |
6de9cd9a | 877 | error_buffer.flag = 0; |
b3ae6c0f | 878 | |
3f139fcf BM |
879 | gfc_increment_error_count(); |
880 | ||
b3ae6c0f SK |
881 | if (flag_fatal_errors) |
882 | exit (1); | |
6de9cd9a DN |
883 | } |
884 | ||
885 | return rc; | |
886 | } | |
887 | ||
888 | ||
889 | /* Save the existing error state. */ | |
890 | ||
891 | void | |
892 | gfc_push_error (gfc_error_buf * err) | |
893 | { | |
6de9cd9a DN |
894 | err->flag = error_buffer.flag; |
895 | if (error_buffer.flag) | |
d71b89ca | 896 | err->message = xstrdup (error_buffer.message); |
6de9cd9a DN |
897 | |
898 | error_buffer.flag = 0; | |
899 | } | |
900 | ||
901 | ||
902 | /* Restore a previous pushed error state. */ | |
903 | ||
904 | void | |
905 | gfc_pop_error (gfc_error_buf * err) | |
906 | { | |
6de9cd9a DN |
907 | error_buffer.flag = err->flag; |
908 | if (error_buffer.flag) | |
d71b89ca JJ |
909 | { |
910 | size_t len = strlen (err->message) + 1; | |
911 | gcc_assert (len <= error_buffer.allocated); | |
912 | memcpy (error_buffer.message, err->message, len); | |
913 | gfc_free (err->message); | |
914 | } | |
915 | } | |
916 | ||
917 | ||
918 | /* Free a pushed error state, but keep the current error state. */ | |
919 | ||
920 | void | |
921 | gfc_free_error (gfc_error_buf * err) | |
922 | { | |
923 | if (err->flag) | |
924 | gfc_free (err->message); | |
6de9cd9a DN |
925 | } |
926 | ||
927 | ||
928 | /* Debug wrapper for printf. */ | |
929 | ||
930 | void | |
31043f6c | 931 | gfc_status (const char *cmsgid, ...) |
6de9cd9a DN |
932 | { |
933 | va_list argp; | |
934 | ||
31043f6c | 935 | va_start (argp, cmsgid); |
6de9cd9a | 936 | |
31043f6c | 937 | vprintf (_(cmsgid), argp); |
6de9cd9a DN |
938 | |
939 | va_end (argp); | |
940 | } | |
941 | ||
942 | ||
943 | /* Subroutine for outputting a single char so that we don't have to go | |
944 | around creating a lot of 1-character strings. */ | |
945 | ||
946 | void | |
947 | gfc_status_char (char c) | |
948 | { | |
949 | putchar (c); | |
950 | } | |
951 | ||
952 | ||
1f2959f0 | 953 | /* Report the number of warnings and errors that occurred to the caller. */ |
6de9cd9a DN |
954 | |
955 | void | |
956 | gfc_get_errors (int *w, int *e) | |
957 | { | |
6de9cd9a DN |
958 | if (w != NULL) |
959 | *w = warnings; | |
960 | if (e != NULL) | |
961 | *e = errors; | |
962 | } |