1/* Handle errors. 2 Copyright (C) 2000-2015 Free Software Foundation, Inc. 3 Contributed by Andy Vaught & Niels Kristian Bech Jensen 4 5This file is part of GCC. 6 7GCC is free software; you can redistribute it and/or modify it under 8the terms of the GNU General Public License as published by the Free 9Software Foundation; either version 3, or (at your option) any later 10version. 11 12GCC is distributed in the hope that it will be useful, but WITHOUT ANY 13WARRANTY; without even the implied warranty of MERCHANTABILITY or 14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 15for more details. 16 17You should have received a copy of the GNU General Public License 18along with GCC; see the file COPYING3. If not see 19<http://www.gnu.org/licenses/>. */ 20 21/* Handle the inevitable errors. A major catch here is that things 22 flagged as errors in one match subroutine can conceivably be legal 23 elsewhere. This means that error messages are recorded and saved 24 for possible use later. If a line does not match a legal 25 construction, then the saved error message is reported. */ 26 27#include "config.h" 28#include "system.h" 29#include "coretypes.h" 30#include "flags.h" 31#include "gfortran.h" 32 33#include "diagnostic.h" 34#include "diagnostic-color.h" 35#include "tree-diagnostic.h" /* tree_diagnostics_defaults */ 36 37#include <new> /* For placement-new */ 38 39static int suppress_errors = 0; 40 41static bool warnings_not_errors = false; 42 43static int terminal_width, errors, warnings; 44 45static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer; 46 47/* True if the error/warnings should be buffered. */ 48static bool buffered_p; 49/* These are always buffered buffers (.flush_p == false) to be used by 50 the pretty-printer. */ 51static output_buffer *pp_error_buffer, *pp_warning_buffer; 52static int warningcount_buffered, werrorcount_buffered; 53 54/* Return true if there output_buffer is empty. */ 55 56static bool 57gfc_output_buffer_empty_p (const output_buffer * buf) 58{ 59 return output_buffer_last_position_in_text (buf) == NULL; 60} 61 62/* Go one level deeper suppressing errors. */ 63 64void 65gfc_push_suppress_errors (void) 66{ 67 gcc_assert (suppress_errors >= 0); 68 ++suppress_errors; 69} 70 71static void 72gfc_error (const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(1,0); 73 74static bool 75gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); 76 77 78/* Leave one level of error suppressing. */ 79 80void 81gfc_pop_suppress_errors (void) 82{ 83 gcc_assert (suppress_errors > 0); 84 --suppress_errors; 85} 86 87 88/* Determine terminal width (for trimming source lines in output). */ 89 90static int 91gfc_get_terminal_width (void) 92{ 93 return isatty (STDERR_FILENO) ? get_terminal_width () : INT_MAX; 94} 95 96 97/* Per-file error initialization. */ 98 99void 100gfc_error_init_1 (void) 101{ 102 terminal_width = gfc_get_terminal_width (); 103 errors = 0; 104 warnings = 0; 105 gfc_buffer_error (false); 106} 107 108 109/* Set the flag for buffering errors or not. */ 110 111void 112gfc_buffer_error (bool flag) 113{ 114 buffered_p = flag; 115} 116 117 118/* Add a single character to the error buffer or output depending on 119 buffered_p. */ 120 121static void 122error_char (char c) 123{ 124 if (buffered_p) 125 { 126 if (cur_error_buffer->index >= cur_error_buffer->allocated) 127 { 128 cur_error_buffer->allocated = cur_error_buffer->allocated 129 ? cur_error_buffer->allocated * 2 : 1000; 130 cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message, 131 cur_error_buffer->allocated); 132 } 133 cur_error_buffer->message[cur_error_buffer->index++] = c; 134 } 135 else 136 { 137 if (c != 0) 138 { 139 /* We build up complete lines before handing things 140 over to the library in order to speed up error printing. */ 141 static char *line; 142 static size_t allocated = 0, index = 0; 143 144 if (index + 1 >= allocated) 145 { 146 allocated = allocated ? allocated * 2 : 1000; 147 line = XRESIZEVEC (char, line, allocated); 148 } 149 line[index++] = c; 150 if (c == '\n') 151 { 152 line[index] = '\0'; 153 fputs (line, stderr); 154 index = 0; 155 } 156 } 157 } 158} 159 160 161/* Copy a string to wherever it needs to go. */ 162 163static void 164error_string (const char *p) 165{ 166 while (*p) 167 error_char (*p++); 168} 169 170 171/* Print a formatted integer to the error buffer or output. */ 172 173#define IBUF_LEN 60 174 175static void 176error_uinteger (unsigned long int i) 177{ 178 char *p, int_buf[IBUF_LEN]; 179 180 p = int_buf + IBUF_LEN - 1; 181 *p-- = '\0'; 182 183 if (i == 0) 184 *p-- = '0'; 185 186 while (i > 0) 187 { 188 *p-- = i % 10 + '0'; 189 i = i / 10; 190 } 191 192 error_string (p + 1); 193} 194 195static void 196error_integer (long int i) 197{ 198 unsigned long int u; 199 200 if (i < 0) 201 { 202 u = (unsigned long int) -i; 203 error_char ('-'); 204 } 205 else 206 u = i; 207 208 error_uinteger (u); 209} 210 211 212static size_t 213gfc_widechar_display_length (gfc_char_t c) 214{ 215 if (gfc_wide_is_printable (c) || c == '\t') 216 /* Printable ASCII character, or tabulation (output as a space). */ 217 return 1; 218 else if (c < ((gfc_char_t) 1 << 8)) 219 /* Displayed as \x?? */ 220 return 4; 221 else if (c < ((gfc_char_t) 1 << 16)) 222 /* Displayed as \u???? */ 223 return 6; 224 else 225 /* Displayed as \U???????? */ 226 return 10; 227} 228 229 230/* Length of the ASCII representation of the wide string, escaping wide 231 characters as print_wide_char_into_buffer() does. */ 232 233static size_t 234gfc_wide_display_length (const gfc_char_t *str) 235{ 236 size_t i, len; 237 238 for (i = 0, len = 0; str[i]; i++) 239 len += gfc_widechar_display_length (str[i]); 240 241 return len; 242} 243 244static int 245print_wide_char_into_buffer (gfc_char_t c, char *buf) 246{ 247 static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6', 248 '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' }; 249 250 if (gfc_wide_is_printable (c) || c == '\t') 251 { 252 buf[1] = '\0'; 253 /* Tabulation is output as a space. */ 254 buf[0] = (unsigned char) (c == '\t' ? ' ' : c); 255 return 1; 256 } 257 else if (c < ((gfc_char_t) 1 << 8)) 258 { 259 buf[4] = '\0'; 260 buf[3] = xdigit[c & 0x0F]; 261 c = c >> 4; 262 buf[2] = xdigit[c & 0x0F]; 263 264 buf[1] = 'x'; 265 buf[0] = '\\'; 266 return 4; 267 } 268 else if (c < ((gfc_char_t) 1 << 16)) 269 { 270 buf[6] = '\0'; 271 buf[5] = xdigit[c & 0x0F]; 272 c = c >> 4; 273 buf[4] = xdigit[c & 0x0F]; 274 c = c >> 4; 275 buf[3] = xdigit[c & 0x0F]; 276 c = c >> 4; 277 buf[2] = xdigit[c & 0x0F]; 278 279 buf[1] = 'u'; 280 buf[0] = '\\'; 281 return 6; 282 } 283 else 284 { 285 buf[10] = '\0'; 286 buf[9] = xdigit[c & 0x0F]; 287 c = c >> 4; 288 buf[8] = xdigit[c & 0x0F]; 289 c = c >> 4; 290 buf[7] = xdigit[c & 0x0F]; 291 c = c >> 4; 292 buf[6] = xdigit[c & 0x0F]; 293 c = c >> 4; 294 buf[5] = xdigit[c & 0x0F]; 295 c = c >> 4; 296 buf[4] = xdigit[c & 0x0F]; 297 c = c >> 4; 298 buf[3] = xdigit[c & 0x0F]; 299 c = c >> 4; 300 buf[2] = xdigit[c & 0x0F]; 301 302 buf[1] = 'U'; 303 buf[0] = '\\'; 304 return 10; 305 } 306} 307 308static char wide_char_print_buffer[11]; 309 310const char * 311gfc_print_wide_char (gfc_char_t c) 312{ 313 print_wide_char_into_buffer (c, wide_char_print_buffer); 314 return wide_char_print_buffer; 315} 316 317 318/* Show the file, where it was included, and the source line, give a 319 locus. Calls error_printf() recursively, but the recursion is at 320 most one level deep. */ 321 322static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); 323 324static void 325show_locus (locus *loc, int c1, int c2) 326{ 327 gfc_linebuf *lb; 328 gfc_file *f; 329 gfc_char_t *p; 330 int i, offset, cmax; 331 332 /* TODO: Either limit the total length and number of included files 333 displayed or add buffering of arbitrary number of characters in 334 error messages. */ 335 336 /* Write out the error header line, giving the source file and error 337 location (in GNU standard "[file]:[line].[column]:" format), 338 followed by an "included by" stack and a blank line. This header 339 format is matched by a testsuite parser defined in 340 lib/gfortran-dg.exp. */ 341 342 lb = loc->lb; 343 f = lb->file; 344 345 error_string (f->filename); 346 error_char (':'); 347 348 error_integer (LOCATION_LINE (lb->location)); 349 350 if ((c1 > 0) || (c2 > 0)) 351 error_char ('.'); 352 353 if (c1 > 0) 354 error_integer (c1); 355 356 if ((c1 > 0) && (c2 > 0)) 357 error_char ('-'); 358 359 if (c2 > 0) 360 error_integer (c2); 361 362 error_char (':'); 363 error_char ('\n'); 364 365 for (;;) 366 { 367 i = f->inclusion_line; 368 369 f = f->up; 370 if (f == NULL) break; 371 372 error_printf (" Included at %s:%d:", f->filename, i); 373 } 374 375 error_char ('\n'); 376 377 /* Calculate an appropriate horizontal offset of the source line in 378 order to get the error locus within the visible portion of the 379 line. Note that if the margin of 5 here is changed, the 380 corresponding margin of 10 in show_loci should be changed. */ 381 382 offset = 0; 383 384 /* If the two loci would appear in the same column, we shift 385 '2' one column to the right, so as to print '12' rather than 386 just '1'. We do this here so it will be accounted for in the 387 margin calculations. */ 388 389 if (c1 == c2) 390 c2 += 1; 391 392 cmax = (c1 < c2) ? c2 : c1; 393 if (cmax > terminal_width - 5) 394 offset = cmax - terminal_width + 5; 395 396 /* Show the line itself, taking care not to print more than what can 397 show up on the terminal. Tabs are converted to spaces, and 398 nonprintable characters are converted to a "\xNN" sequence. */ 399 400 p = &(lb->line[offset]); 401 i = gfc_wide_display_length (p); 402 if (i > terminal_width) 403 i = terminal_width - 1; 404 405 while (i > 0) 406 { 407 static char buffer[11]; 408 i -= print_wide_char_into_buffer (*p++, buffer); 409 error_string (buffer); 410 } 411 412 error_char ('\n'); 413 414 /* Show the '1' and/or '2' corresponding to the column of the error 415 locus. Note that a value of -1 for c1 or c2 will simply cause 416 the relevant number not to be printed. */ 417 418 c1 -= offset; 419 c2 -= offset; 420 cmax -= offset; 421 422 p = &(lb->line[offset]); 423 for (i = 0; i < cmax; i++) 424 { 425 int spaces, j; 426 spaces = gfc_widechar_display_length (*p++); 427 428 if (i == c1) 429 error_char ('1'), spaces--; 430 else if (i == c2) 431 error_char ('2'), spaces--; 432 433 for (j = 0; j < spaces; j++) 434 error_char (' '); 435 } 436 437 if (i == c1) 438 error_char ('1'); 439 else if (i == c2) 440 error_char ('2'); 441 442 error_char ('\n'); 443 444} 445 446 447/* As part of printing an error, we show the source lines that caused 448 the problem. We show at least one, and possibly two loci; the two 449 loci may or may not be on the same source line. */ 450 451static void 452show_loci (locus *l1, locus *l2) 453{ 454 int m, c1, c2; 455 456 if (l1 == NULL || l1->lb == NULL) 457 { 458 error_printf ("<During initialization>\n"); 459 return; 460 } 461 462 /* While calculating parameters for printing the loci, we consider possible 463 reasons for printing one per line. If appropriate, print the loci 464 individually; otherwise we print them both on the same line. */ 465 466 c1 = l1->nextc - l1->lb->line; 467 if (l2 == NULL) 468 { 469 show_locus (l1, c1, -1); 470 return; 471 } 472 473 c2 = l2->nextc - l2->lb->line; 474 475 if (c1 < c2) 476 m = c2 - c1; 477 else 478 m = c1 - c2; 479 480 /* Note that the margin value of 10 here needs to be less than the 481 margin of 5 used in the calculation of offset in show_locus. */ 482 483 if (l1->lb != l2->lb || m > terminal_width - 10) 484 { 485 show_locus (l1, c1, -1); 486 show_locus (l2, -1, c2); 487 return; 488 } 489 490 show_locus (l1, c1, c2); 491 492 return; 493} 494 495 496/* Workhorse for the error printing subroutines. This subroutine is 497 inspired by g77's error handling and is similar to printf() with 498 the following %-codes: 499 500 %c Character, %d or %i Integer, %s String, %% Percent 501 %L Takes locus argument 502 %C Current locus (no argument) 503 504 If a locus pointer is given, the actual source line is printed out 505 and the column is indicated. Since we want the error message at 506 the bottom of any source file information, we must scan the 507 argument list twice -- once to determine whether the loci are 508 present and record this for printing, and once to print the error 509 message after and loci have been printed. A maximum of two locus 510 arguments are permitted. 511 512 This function is also called (recursively) by show_locus in the 513 case of included files; however, as show_locus does not resupply 514 any loci, the recursion is at most one level deep. */ 515 516#define MAX_ARGS 10 517 518static void ATTRIBUTE_GCC_GFC(2,0) 519error_print (const char *type, const char *format0, va_list argp) 520{ 521 enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER, 522 TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING, 523 NOTYPE }; 524 struct 525 { 526 int type; 527 int pos; 528 union 529 { 530 int intval; 531 unsigned int uintval; 532 long int longintval; 533 unsigned long int ulongintval; 534 char charval; 535 const char * stringval; 536 } u; 537 } arg[MAX_ARGS], spec[MAX_ARGS]; 538 /* spec is the array of specifiers, in the same order as they 539 appear in the format string. arg is the array of arguments, 540 in the same order as they appear in the va_list. */ 541 542 char c; 543 int i, n, have_l1, pos, maxpos; 544 locus *l1, *l2, *loc; 545 const char *format; 546 547 loc = l1 = l2 = NULL; 548 549 have_l1 = 0; 550 pos = -1; 551 maxpos = -1; 552 553 n = 0; 554 format = format0; 555 556 for (i = 0; i < MAX_ARGS; i++) 557 { 558 arg[i].type = NOTYPE; 559 spec[i].pos = -1; 560 } 561 562 /* First parse the format string for position specifiers. */ 563 while (*format) 564 { 565 c = *format++; 566 if (c != '%') 567 continue; 568 569 if (*format == '%') 570 { 571 format++; 572 continue; 573 } 574 575 if (ISDIGIT (*format)) 576 { 577 /* This is a position specifier. For example, the number 578 12 in the format string "%12$d", which specifies the third 579 argument of the va_list, formatted in %d format. 580 For details, see "man 3 printf". */ 581 pos = atoi(format) - 1; 582 gcc_assert (pos >= 0); 583 while (ISDIGIT(*format)) 584 format++; 585 gcc_assert (*format == '$'); 586 format++; 587 } 588 else 589 pos++; 590 591 c = *format++; 592 593 if (pos > maxpos) 594 maxpos = pos; 595 596 switch (c) 597 { 598 case 'C': 599 arg[pos].type = TYPE_CURRENTLOC; 600 break; 601 602 case 'L': 603 arg[pos].type = TYPE_LOCUS; 604 break; 605 606 case 'd': 607 case 'i': 608 arg[pos].type = TYPE_INTEGER; 609 break; 610 611 case 'u': 612 arg[pos].type = TYPE_UINTEGER; 613 break; 614 615 case 'l': 616 c = *format++; 617 if (c == 'u') 618 arg[pos].type = TYPE_ULONGINT; 619 else if (c == 'i' || c == 'd') 620 arg[pos].type = TYPE_LONGINT; 621 else 622 gcc_unreachable (); 623 break; 624 625 case 'c': 626 arg[pos].type = TYPE_CHAR; 627 break; 628 629 case 's': 630 arg[pos].type = TYPE_STRING; 631 break; 632 633 default: 634 gcc_unreachable (); 635 } 636 637 spec[n++].pos = pos; 638 } 639 640 /* Then convert the values for each %-style argument. */ 641 for (pos = 0; pos <= maxpos; pos++) 642 { 643 gcc_assert (arg[pos].type != NOTYPE); 644 switch (arg[pos].type) 645 { 646 case TYPE_CURRENTLOC: 647 loc = &gfc_current_locus; 648 /* Fall through. */ 649 650 case TYPE_LOCUS: 651 if (arg[pos].type == TYPE_LOCUS) 652 loc = va_arg (argp, locus *); 653 654 if (have_l1) 655 { 656 l2 = loc; 657 arg[pos].u.stringval = "(2)"; 658 } 659 else 660 { 661 l1 = loc; 662 have_l1 = 1; 663 arg[pos].u.stringval = "(1)"; 664 } 665 break; 666 667 case TYPE_INTEGER: 668 arg[pos].u.intval = va_arg (argp, int); 669 break; 670 671 case TYPE_UINTEGER: 672 arg[pos].u.uintval = va_arg (argp, unsigned int); 673 break; 674 675 case TYPE_LONGINT: 676 arg[pos].u.longintval = va_arg (argp, long int); 677 break; 678 679 case TYPE_ULONGINT: 680 arg[pos].u.ulongintval = va_arg (argp, unsigned long int); 681 break; 682 683 case TYPE_CHAR: 684 arg[pos].u.charval = (char) va_arg (argp, int); 685 break; 686 687 case TYPE_STRING: 688 arg[pos].u.stringval = (const char *) va_arg (argp, char *); 689 break; 690 691 default: 692 gcc_unreachable (); 693 } 694 } 695 696 for (n = 0; spec[n].pos >= 0; n++) 697 spec[n].u = arg[spec[n].pos].u; 698 699 /* Show the current loci if we have to. */ 700 if (have_l1) 701 show_loci (l1, l2); 702 703 if (*type) 704 { 705 error_string (type); 706 error_char (' '); 707 } 708 709 have_l1 = 0; 710 format = format0; 711 n = 0; 712 713 for (; *format; format++) 714 { 715 if (*format != '%') 716 { 717 error_char (*format); 718 continue; 719 } 720 721 format++; 722 if (ISDIGIT (*format)) 723 { 724 /* This is a position specifier. See comment above. */ 725 while (ISDIGIT (*format)) 726 format++; 727 728 /* Skip over the dollar sign. */ 729 format++; 730 } 731 732 switch (*format) 733 { 734 case '%': 735 error_char ('%'); 736 break; 737 738 case 'c': 739 error_char (spec[n++].u.charval); 740 break; 741 742 case 's': 743 case 'C': /* Current locus */ 744 case 'L': /* Specified locus */ 745 error_string (spec[n++].u.stringval); 746 break; 747 748 case 'd': 749 case 'i': 750 error_integer (spec[n++].u.intval); 751 break; 752 753 case 'u': 754 error_uinteger (spec[n++].u.uintval); 755 break; 756 757 case 'l': 758 format++; 759 if (*format == 'u') 760 error_uinteger (spec[n++].u.ulongintval); 761 else 762 error_integer (spec[n++].u.longintval); 763 break; 764 765 } 766 } 767 768 error_char ('\n'); 769} 770 771 772/* Wrapper for error_print(). */ 773 774static void 775error_printf (const char *gmsgid, ...) 776{ 777 va_list argp; 778 779 va_start (argp, gmsgid); 780 error_print ("", _(gmsgid), argp); 781 va_end (argp); 782} 783 784 785/* Increment the number of errors, and check whether too many have 786 been printed. */ 787 788static void 789gfc_increment_error_count (void) 790{ 791 errors++; 792 if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors)) 793 gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors); 794} 795 796 797/* Clear any output buffered in a pretty-print output_buffer. */ 798 799static void 800gfc_clear_pp_buffer (output_buffer *this_buffer) 801{ 802 pretty_printer *pp = global_dc->printer; 803 output_buffer *tmp_buffer = pp->buffer; 804 pp->buffer = this_buffer; 805 pp_clear_output_area (pp); 806 pp->buffer = tmp_buffer; 807 /* We need to reset last_location, otherwise we may skip caret lines 808 when we actually give a diagnostic. */ 809 global_dc->last_location = UNKNOWN_LOCATION; 810} 811 812 813/* Issue a warning. */ 814/* Use gfc_warning instead, unless two locations are used in the same 815 warning or for scanner.c, if the location is not properly set up. */ 816 817void 818gfc_warning_1 (const char *gmsgid, ...) 819{ 820 va_list argp; 821 822 if (inhibit_warnings) 823 return; 824 825 warning_buffer.flag = 1; 826 warning_buffer.index = 0; 827 cur_error_buffer = &warning_buffer; 828 829 va_start (argp, gmsgid); 830 error_print (_("Warning:"), _(gmsgid), argp); 831 va_end (argp); 832 833 error_char ('\0'); 834 835 if (!buffered_p) 836 { 837 warnings++; 838 if (warnings_are_errors) 839 gfc_increment_error_count(); 840 } 841} 842 843 844/* This is just a helper function to avoid duplicating the logic of 845 gfc_warning. */ 846 847static bool 848gfc_warning (int opt, const char *gmsgid, va_list ap) 849{ 850 va_list argp; 851 va_copy (argp, ap); 852 853 diagnostic_info diagnostic; 854 bool fatal_errors = global_dc->fatal_errors; 855 pretty_printer *pp = global_dc->printer; 856 output_buffer *tmp_buffer = pp->buffer; 857 858 gfc_clear_pp_buffer (pp_warning_buffer); 859 860 if (buffered_p) 861 { 862 pp->buffer = pp_warning_buffer; 863 global_dc->fatal_errors = false; 864 /* To prevent -fmax-errors= triggering. */ 865 --werrorcount; 866 } 867 868 diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, 869 DK_WARNING); 870 diagnostic.option_index = opt; 871 bool ret = report_diagnostic (&diagnostic); 872 873 if (buffered_p) 874 { 875 pp->buffer = tmp_buffer; 876 global_dc->fatal_errors = fatal_errors; 877 878 warningcount_buffered = 0; 879 werrorcount_buffered = 0; 880 /* Undo the above --werrorcount if not Werror, otherwise 881 werrorcount is correct already. */ 882 if (!ret) 883 ++werrorcount; 884 else if (diagnostic.kind == DK_ERROR) 885 ++werrorcount_buffered; 886 else 887 ++werrorcount, --warningcount, ++warningcount_buffered; 888 } 889 890 va_end (argp); 891 return ret; 892} 893 894/* Issue a warning. */ 895/* This function uses the common diagnostics, but does not support 896 two locations; when being used in scanner.c, ensure that the location 897 is properly setup. Otherwise, use gfc_warning_1. */ 898 899bool 900gfc_warning (int opt, const char *gmsgid, ...) 901{ 902 va_list argp; 903 904 va_start (argp, gmsgid); 905 bool ret = gfc_warning (opt, gmsgid, argp); 906 va_end (argp); 907 return ret; 908} 909 910 911/* Whether, for a feature included in a given standard set (GFC_STD_*), 912 we should issue an error or a warning, or be quiet. */ 913 914notification 915gfc_notification_std (int std) 916{ 917 bool warning; 918 919 warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings; 920 if ((gfc_option.allow_std & std) != 0 && !warning) 921 return SILENT; 922 923 return warning ? WARNING : ERROR; 924} 925 926 927/* Possibly issue a warning/error about use of a nonstandard (or deleted) 928 feature. An error/warning will be issued if the currently selected 929 standard does not contain the requested bits. Return false if 930 an error is generated. */ 931 932bool 933gfc_notify_std_1 (int std, const char *gmsgid, ...) 934{ 935 va_list argp; 936 bool warning; 937 const char *msg1, *msg2; 938 char *buffer; 939 940 warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings; 941 if ((gfc_option.allow_std & std) != 0 && !warning) 942 return true; 943 944 if (suppress_errors) 945 return warning ? true : false; 946 947 cur_error_buffer = warning ? &warning_buffer : &error_buffer; 948 cur_error_buffer->flag = 1; 949 cur_error_buffer->index = 0; 950 951 if (warning) 952 msg1 = _("Warning:"); 953 else 954 msg1 = _("Error:"); 955 956 switch (std) 957 { 958 case GFC_STD_F2008_TS: 959 msg2 = "TS 29113/TS 18508:"; 960 break; 961 case GFC_STD_F2008_OBS: 962 msg2 = _("Fortran 2008 obsolescent feature:"); 963 break; 964 case GFC_STD_F2008: 965 msg2 = "Fortran 2008:"; 966 break; 967 case GFC_STD_F2003: 968 msg2 = "Fortran 2003:"; 969 break; 970 case GFC_STD_GNU: 971 msg2 = _("GNU Extension:"); 972 break; 973 case GFC_STD_LEGACY: 974 msg2 = _("Legacy Extension:"); 975 break; 976 case GFC_STD_F95_OBS: 977 msg2 = _("Obsolescent feature:"); 978 break; 979 case GFC_STD_F95_DEL: 980 msg2 = _("Deleted feature:"); 981 break; 982 default: 983 gcc_unreachable (); 984 } 985 986 buffer = (char *) alloca (strlen (msg1) + strlen (msg2) + 2); 987 strcpy (buffer, msg1); 988 strcat (buffer, " "); 989 strcat (buffer, msg2); 990 991 va_start (argp, gmsgid); 992 error_print (buffer, _(gmsgid), argp); 993 va_end (argp); 994 995 error_char ('\0'); 996 997 if (!buffered_p) 998 { 999 if (warning && !warnings_are_errors) 1000 warnings++; 1001 else 1002 gfc_increment_error_count(); 1003 cur_error_buffer->flag = 0; 1004 } 1005 1006 return (warning && !warnings_are_errors) ? true : false; 1007} 1008 1009 1010bool 1011gfc_notify_std (int std, const char *gmsgid, ...) 1012{ 1013 va_list argp; 1014 bool warning; 1015 const char *msg, *msg2; 1016 char *buffer; 1017 1018 warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings; 1019 if ((gfc_option.allow_std & std) != 0 && !warning) 1020 return true; 1021 1022 if (suppress_errors) 1023 return warning ? true : false; 1024 1025 switch (std) 1026 { 1027 case GFC_STD_F2008_TS: 1028 msg = "TS 29113/TS 18508:"; 1029 break; 1030 case GFC_STD_F2008_OBS: 1031 msg = _("Fortran 2008 obsolescent feature:"); 1032 break; 1033 case GFC_STD_F2008: 1034 msg = "Fortran 2008:"; 1035 break; 1036 case GFC_STD_F2003: 1037 msg = "Fortran 2003:"; 1038 break; 1039 case GFC_STD_GNU: 1040 msg = _("GNU Extension:"); 1041 break; 1042 case GFC_STD_LEGACY: 1043 msg = _("Legacy Extension:"); 1044 break; 1045 case GFC_STD_F95_OBS: 1046 msg = _("Obsolescent feature:"); 1047 break; 1048 case GFC_STD_F95_DEL: 1049 msg = _("Deleted feature:"); 1050 break; 1051 default: 1052 gcc_unreachable (); 1053 } 1054 1055 msg2 = _(gmsgid); 1056 buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2); 1057 strcpy (buffer, msg); 1058 strcat (buffer, " "); 1059 strcat (buffer, msg2); 1060 1061 va_start (argp, gmsgid); 1062 if (warning) 1063 gfc_warning (0, buffer, argp); 1064 else 1065 gfc_error (buffer, argp); 1066 va_end (argp); 1067 1068 return (warning && !warnings_are_errors) ? true : false; 1069} 1070 1071 1072/* Immediate warning (i.e. do not buffer the warning). */ 1073/* Use gfc_warning_now instead, unless two locations are used in the same 1074 warning or for scanner.c, if the location is not properly set up. */ 1075 1076void 1077gfc_warning_now_1 (const char *gmsgid, ...) 1078{ 1079 va_list argp; 1080 bool buffered_p_saved; 1081 1082 if (inhibit_warnings) 1083 return; 1084 1085 buffered_p_saved = buffered_p; 1086 buffered_p = false; 1087 warnings++; 1088 1089 va_start (argp, gmsgid); 1090 error_print (_("Warning:"), _(gmsgid), argp); 1091 va_end (argp); 1092 1093 error_char ('\0'); 1094 1095 if (warnings_are_errors) 1096 gfc_increment_error_count(); 1097 1098 buffered_p = buffered_p_saved; 1099} 1100 1101/* Called from output_format -- during diagnostic message processing 1102 to handle Fortran specific format specifiers with the following meanings: 1103 1104 %C Current locus (no argument) 1105 %L Takes locus argument 1106*/ 1107static bool 1108gfc_format_decoder (pretty_printer *pp, 1109 text_info *text, const char *spec, 1110 int precision ATTRIBUTE_UNUSED, bool wide ATTRIBUTE_UNUSED, 1111 bool plus ATTRIBUTE_UNUSED, bool hash ATTRIBUTE_UNUSED) 1112{ 1113 switch (*spec) 1114 { 1115 case 'C': 1116 case 'L': 1117 { 1118 static const char *result = "(1)"; 1119 locus *loc; 1120 if (*spec == 'C') 1121 loc = &gfc_current_locus; 1122 else 1123 loc = va_arg (*text->args_ptr, locus *); 1124 gcc_assert (loc->nextc - loc->lb->line >= 0); 1125 unsigned int offset = loc->nextc - loc->lb->line; 1126 gcc_assert (text->locus); 1127 *text->locus 1128 = linemap_position_for_loc_and_offset (line_table, 1129 loc->lb->location, 1130 offset); 1131 global_dc->caret_char = '1'; 1132 pp_string (pp, result); 1133 return true; 1134 } 1135 default: 1136 return false; 1137 } 1138} 1139 1140/* Return a malloc'd string describing a location. The caller is 1141 responsible for freeing the memory. */ 1142static char * 1143gfc_diagnostic_build_prefix (diagnostic_context *context, 1144 const diagnostic_info *diagnostic) 1145{ 1146 static const char *const diagnostic_kind_text[] = { 1147#define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T), 1148#include "gfc-diagnostic.def" 1149#undef DEFINE_DIAGNOSTIC_KIND 1150 "must-not-happen" 1151 }; 1152 static const char *const diagnostic_kind_color[] = { 1153#define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C), 1154#include "gfc-diagnostic.def" 1155#undef DEFINE_DIAGNOSTIC_KIND 1156 NULL 1157 }; 1158 gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND); 1159 const char *text = _(diagnostic_kind_text[diagnostic->kind]); 1160 const char *text_cs = "", *text_ce = ""; 1161 pretty_printer *pp = context->printer; 1162 1163 if (diagnostic_kind_color[diagnostic->kind]) 1164 { 1165 text_cs = colorize_start (pp_show_color (pp), 1166 diagnostic_kind_color[diagnostic->kind]); 1167 text_ce = colorize_stop (pp_show_color (pp)); 1168 } 1169 return build_message_string ("%s%s:%s ", text_cs, text, text_ce); 1170} 1171 1172/* Return a malloc'd string describing a location. The caller is 1173 responsible for freeing the memory. */ 1174static char * 1175gfc_diagnostic_build_locus_prefix (diagnostic_context *context, 1176 const diagnostic_info *diagnostic) 1177{ 1178 pretty_printer *pp = context->printer; 1179 const char *locus_cs = colorize_start (pp_show_color (pp), "locus"); 1180 const char *locus_ce = colorize_stop (pp_show_color (pp)); 1181 expanded_location s = diagnostic_expand_location (diagnostic); 1182 return (s.file == NULL 1183 ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce ) 1184 : !strcmp (s.file, N_("<built-in>")) 1185 ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce) 1186 : context->show_column 1187 ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line, 1188 s.column, locus_ce) 1189 : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce)); 1190} 1191 1192static void 1193gfc_diagnostic_starter (diagnostic_context *context, 1194 diagnostic_info *diagnostic) 1195{ 1196 char * locus_prefix = gfc_diagnostic_build_locus_prefix (context, diagnostic); 1197 char * prefix = gfc_diagnostic_build_prefix (context, diagnostic); 1198 /* First we assume there is a caret line. */ 1199 pp_set_prefix (context->printer, NULL); 1200 if (pp_needs_newline (context->printer)) 1201 pp_newline (context->printer); 1202 pp_verbatim (context->printer, locus_prefix); 1203 /* Fortran uses an empty line between locus and caret line. */ 1204 pp_newline (context->printer); 1205 diagnostic_show_locus (context, diagnostic); 1206 if (pp_needs_newline (context->printer)) 1207 { 1208 pp_newline (context->printer); 1209 /* If the caret line was shown, the prefix does not contain the 1210 locus. */ 1211 pp_set_prefix (context->printer, prefix); 1212 } 1213 else 1214 { 1215 /* Otherwise, start again. */ 1216 pp_clear_output_area(context->printer); 1217 pp_set_prefix (context->printer, concat (locus_prefix, " ", prefix, NULL)); 1218 free (prefix); 1219 } 1220 free (locus_prefix); 1221} 1222 1223static void 1224gfc_diagnostic_finalizer (diagnostic_context *context, 1225 diagnostic_info *diagnostic ATTRIBUTE_UNUSED) 1226{ 1227 pp_destroy_prefix (context->printer); 1228 pp_newline_and_flush (context->printer); 1229} 1230 1231/* Immediate warning (i.e. do not buffer the warning). */ 1232/* This function uses the common diagnostics, but does not support 1233 two locations; when being used in scanner.c, ensure that the location 1234 is properly setup. Otherwise, use gfc_warning_now_1. */ 1235 1236bool 1237gfc_warning_now (int opt, const char *gmsgid, ...) 1238{ 1239 va_list argp; 1240 diagnostic_info diagnostic; 1241 bool ret; 1242 1243 va_start (argp, gmsgid); 1244 diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, 1245 DK_WARNING); 1246 diagnostic.option_index = opt; 1247 ret = report_diagnostic (&diagnostic); 1248 va_end (argp); 1249 return ret; 1250} 1251 1252 1253/* Immediate error (i.e. do not buffer). */ 1254/* This function uses the common diagnostics, but does not support 1255 two locations; when being used in scanner.c, ensure that the location 1256 is properly setup. Otherwise, use gfc_error_now_1. */ 1257 1258void 1259gfc_error_now (const char *gmsgid, ...) 1260{ 1261 va_list argp; 1262 diagnostic_info diagnostic; 1263 1264 va_start (argp, gmsgid); 1265 diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR); 1266 report_diagnostic (&diagnostic); 1267 va_end (argp); 1268} 1269 1270 1271/* Fatal error, never returns. */ 1272 1273void 1274gfc_fatal_error (const char *gmsgid, ...) 1275{ 1276 va_list argp; 1277 diagnostic_info diagnostic; 1278 1279 va_start (argp, gmsgid); 1280 diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_FATAL); 1281 report_diagnostic (&diagnostic); 1282 va_end (argp); 1283 1284 gcc_unreachable (); 1285} 1286 1287/* Clear the warning flag. */ 1288 1289void 1290gfc_clear_warning (void) 1291{ 1292 warning_buffer.flag = 0; 1293 1294 gfc_clear_pp_buffer (pp_warning_buffer); 1295 warningcount_buffered = 0; 1296 werrorcount_buffered = 0; 1297} 1298 1299 1300/* Check to see if any warnings have been saved. 1301 If so, print the warning. */ 1302 1303void 1304gfc_warning_check (void) 1305{ 1306 if (warning_buffer.flag) 1307 { 1308 warnings++; 1309 if (warning_buffer.message != NULL) 1310 fputs (warning_buffer.message, stderr); 1311 gfc_clear_warning (); 1312 } 1313 /* This is for the new diagnostics machinery. */ 1314 else if (! gfc_output_buffer_empty_p (pp_warning_buffer)) 1315 { 1316 pretty_printer *pp = global_dc->printer; 1317 output_buffer *tmp_buffer = pp->buffer; 1318 pp->buffer = pp_warning_buffer; 1319 pp_really_flush (pp); 1320 warningcount += warningcount_buffered; 1321 werrorcount += werrorcount_buffered; 1322 gcc_assert (warningcount_buffered + werrorcount_buffered == 1); 1323 diagnostic_action_after_output (global_dc, 1324 warningcount_buffered 1325 ? DK_WARNING : DK_ERROR); 1326 pp->buffer = tmp_buffer; 1327 } 1328} 1329 1330 1331/* Issue an error. */ 1332/* Use gfc_error instead, unless two locations are used in the same 1333 warning or for scanner.c, if the location is not properly set up. */ 1334 1335void 1336gfc_error_1 (const char *gmsgid, ...) 1337{ 1338 va_list argp; 1339 1340 if (warnings_not_errors) 1341 goto warning; 1342 1343 if (suppress_errors) 1344 return; 1345 1346 error_buffer.flag = 1; 1347 error_buffer.index = 0; 1348 cur_error_buffer = &error_buffer; 1349 1350 va_start (argp, gmsgid); 1351 error_print (_("Error:"), _(gmsgid), argp); 1352 va_end (argp); 1353 1354 error_char ('\0'); 1355 1356 if (!buffered_p) 1357 gfc_increment_error_count(); 1358 1359 return; 1360 1361warning: 1362 1363 if (inhibit_warnings) 1364 return; 1365 1366 warning_buffer.flag = 1; 1367 warning_buffer.index = 0; 1368 cur_error_buffer = &warning_buffer; 1369 1370 va_start (argp, gmsgid); 1371 error_print (_("Warning:"), _(gmsgid), argp); 1372 va_end (argp); 1373 1374 error_char ('\0'); 1375 1376 if (!buffered_p) 1377 { 1378 warnings++; 1379 if (warnings_are_errors) 1380 gfc_increment_error_count(); 1381 } 1382} 1383 1384/* Issue an error. */ 1385/* This function uses the common diagnostics, but does not support 1386 two locations; when being used in scanner.c, ensure that the location 1387 is properly setup. Otherwise, use gfc_error_1. */ 1388 1389static void 1390gfc_error (const char *gmsgid, va_list ap) 1391{ 1392 va_list argp; 1393 va_copy (argp, ap); 1394 bool saved_abort_on_error = false; 1395 1396 if (warnings_not_errors) 1397 { 1398 gfc_warning (/*opt=*/0, gmsgid, argp); 1399 va_end (argp); 1400 return; 1401 } 1402 1403 if (suppress_errors) 1404 { 1405 va_end (argp); 1406 return; 1407 } 1408 1409 diagnostic_info diagnostic; 1410 bool fatal_errors = global_dc->fatal_errors; 1411 pretty_printer *pp = global_dc->printer; 1412 output_buffer *tmp_buffer = pp->buffer; 1413 1414 gfc_clear_pp_buffer (pp_error_buffer); 1415 1416 if (buffered_p) 1417 { 1418 /* To prevent -dH from triggering an abort on a buffered error, 1419 save abort_on_error and restore it below. */ 1420 saved_abort_on_error = global_dc->abort_on_error; 1421 global_dc->abort_on_error = false; 1422 pp->buffer = pp_error_buffer; 1423 global_dc->fatal_errors = false; 1424 /* To prevent -fmax-errors= triggering, we decrease it before 1425 report_diagnostic increases it. */ 1426 --errorcount; 1427 } 1428 1429 diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR); 1430 report_diagnostic (&diagnostic); 1431 1432 if (buffered_p) 1433 { 1434 pp->buffer = tmp_buffer; 1435 global_dc->fatal_errors = fatal_errors; 1436 global_dc->abort_on_error = saved_abort_on_error; 1437 1438 } 1439 1440 va_end (argp); 1441} 1442 1443 1444void 1445gfc_error (const char *gmsgid, ...) 1446{ 1447 va_list argp; 1448 va_start (argp, gmsgid); 1449 gfc_error (gmsgid, argp); 1450 va_end (argp); 1451} 1452 1453 1454/* Immediate error. */ 1455/* Use gfc_error_now instead, unless two locations are used in the same 1456 warning or for scanner.c, if the location is not properly set up. */ 1457 1458void 1459gfc_error_now_1 (const char *gmsgid, ...) 1460{ 1461 va_list argp; 1462 bool buffered_p_saved; 1463 1464 error_buffer.flag = 1; 1465 error_buffer.index = 0; 1466 cur_error_buffer = &error_buffer; 1467 1468 buffered_p_saved = buffered_p; 1469 buffered_p = false; 1470 1471 va_start (argp, gmsgid); 1472 error_print (_("Error:"), _(gmsgid), argp); 1473 va_end (argp); 1474 1475 error_char ('\0'); 1476 1477 gfc_increment_error_count(); 1478 1479 buffered_p = buffered_p_saved; 1480 1481 if (flag_fatal_errors) 1482 exit (FATAL_EXIT_CODE); 1483} 1484 1485 1486/* This shouldn't happen... but sometimes does. */ 1487 1488void 1489gfc_internal_error (const char *gmsgid, ...) 1490{ 1491 va_list argp; 1492 diagnostic_info diagnostic; 1493 1494 va_start (argp, gmsgid); 1495 diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ICE); 1496 report_diagnostic (&diagnostic); 1497 va_end (argp); 1498 1499 gcc_unreachable (); 1500} 1501 1502 1503/* Clear the error flag when we start to compile a source line. */ 1504 1505void 1506gfc_clear_error (void) 1507{ 1508 error_buffer.flag = 0; 1509 warnings_not_errors = false; 1510 gfc_clear_pp_buffer (pp_error_buffer); 1511} 1512 1513 1514/* Tests the state of error_flag. */ 1515 1516bool 1517gfc_error_flag_test (void) 1518{ 1519 return error_buffer.flag 1520 || !gfc_output_buffer_empty_p (pp_error_buffer); 1521} 1522 1523 1524/* Check to see if any errors have been saved. 1525 If so, print the error. Returns the state of error_flag. */ 1526 1527bool 1528gfc_error_check (void) 1529{ 1530 bool error_raised = (bool) error_buffer.flag; 1531 1532 if (error_raised) 1533 { 1534 if (error_buffer.message != NULL) 1535 fputs (error_buffer.message, stderr); 1536 error_buffer.flag = 0; 1537 gfc_clear_pp_buffer (pp_error_buffer); 1538 1539 gfc_increment_error_count(); 1540 1541 if (flag_fatal_errors) 1542 exit (FATAL_EXIT_CODE); 1543 } 1544 /* This is for the new diagnostics machinery. */ 1545 else if (! gfc_output_buffer_empty_p (pp_error_buffer)) 1546 { 1547 error_raised = true; 1548 pretty_printer *pp = global_dc->printer; 1549 output_buffer *tmp_buffer = pp->buffer; 1550 pp->buffer = pp_error_buffer; 1551 pp_really_flush (pp); 1552 ++errorcount; 1553 gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer)); 1554 diagnostic_action_after_output (global_dc, DK_ERROR); 1555 pp->buffer = tmp_buffer; 1556 } 1557 1558 return error_raised; 1559} 1560 1561/* Move the text buffered from FROM to TO, then clear 1562 FROM. Independently if there was text in FROM, TO is also 1563 cleared. */ 1564 1565static void 1566gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to) 1567{ 1568 gfc_clear_pp_buffer (to); 1569 /* We make sure this is always buffered. */ 1570 to->flush_p = false; 1571 1572 if (! gfc_output_buffer_empty_p (from)) 1573 { 1574 const char *str = output_buffer_formatted_text (from); 1575 output_buffer_append_r (to, str, strlen (str)); 1576 gfc_clear_pp_buffer (from); 1577 } 1578} 1579 1580/* Save the existing error state. */ 1581 1582void 1583gfc_push_error (output_buffer *buffer_err, gfc_error_buf *err) 1584{ 1585 err->flag = error_buffer.flag; 1586 if (error_buffer.flag) 1587 err->message = xstrdup (error_buffer.message); 1588 1589 error_buffer.flag = 0; 1590 1591 /* This part uses the common diagnostics. */ 1592 gfc_move_output_buffer_from_to (pp_error_buffer, buffer_err); 1593} 1594 1595 1596/* Restore a previous pushed error state. */ 1597 1598void 1599gfc_pop_error (output_buffer *buffer_err, gfc_error_buf *err) 1600{ 1601 error_buffer.flag = err->flag; 1602 if (error_buffer.flag) 1603 { 1604 size_t len = strlen (err->message) + 1; 1605 gcc_assert (len <= error_buffer.allocated); 1606 memcpy (error_buffer.message, err->message, len); 1607 free (err->message); 1608 } 1609 /* This part uses the common diagnostics. */ 1610 gfc_move_output_buffer_from_to (buffer_err, pp_error_buffer); 1611} 1612 1613 1614/* Free a pushed error state, but keep the current error state. */ 1615 1616void 1617gfc_free_error (output_buffer *buffer_err, gfc_error_buf *err) 1618{ 1619 if (err->flag) 1620 free (err->message); 1621 1622 gfc_clear_pp_buffer (buffer_err); 1623} 1624 1625 1626/* Report the number of warnings and errors that occurred to the caller. */ 1627 1628void 1629gfc_get_errors (int *w, int *e) 1630{ 1631 if (w != NULL) 1632 *w = warnings + warningcount + werrorcount; 1633 if (e != NULL) 1634 *e = errors + errorcount + sorrycount + werrorcount; 1635} 1636 1637 1638/* Switch errors into warnings. */ 1639 1640void 1641gfc_errors_to_warnings (bool f) 1642{ 1643 warnings_not_errors = f; 1644} 1645 1646void 1647gfc_diagnostics_init (void) 1648{ 1649 diagnostic_starter (global_dc) = gfc_diagnostic_starter; 1650 diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer; 1651 diagnostic_format_decoder (global_dc) = gfc_format_decoder; 1652 global_dc->caret_char = '^'; 1653 pp_warning_buffer = new (XNEW (output_buffer)) output_buffer (); 1654 pp_warning_buffer->flush_p = false; 1655 pp_error_buffer = new (XNEW (output_buffer)) output_buffer (); 1656 pp_error_buffer->flush_p = false; 1657} 1658 1659void 1660gfc_diagnostics_finish (void) 1661{ 1662 tree_diagnostics_defaults (global_dc); 1663 /* We still want to use the gfc starter and finalizer, not the tree 1664 defaults. */ 1665 diagnostic_starter (global_dc) = gfc_diagnostic_starter; 1666 diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer; 1667 global_dc->caret_char = '^'; 1668} 1669