gcc/fortran/error.c

   1 /* Handle errors.
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
   3    Foundation, Inc.
   4    Contributed by Andy Vaught & Niels Kristian Bech Jensen
   5
   6 This file is part of GCC.
   7
   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.
  12
  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.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING.  If not, write to the Free
  20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
  21 02110-1301, USA.  */
  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"
  31 #include "flags.h"
  32 #include "gfortran.h"
  33
  34 int gfc_suppress_error = 0;
  35
  36 static int terminal_width, buffer_flag, errors, warnings;
  37
  38 static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
  39
  40
  41 /* Per-file error initialization.  */
  42
  43 void
  44 gfc_error_init_1 (void)
  45 {
  46   terminal_width = gfc_terminal_width ();
  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 {
  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 {
  68   if (buffer_flag)
  69     {
  70       if (cur_error_buffer->index >= cur_error_buffer->allocated)
  71         {
  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);
  78         }
  79       cur_error_buffer->message[cur_error_buffer->index++] = c;
  80     }
  81   else
  82     {
  83       if (c != 0)
  84         {
  85           /* We build up complete lines before handing things
  86              over to the library in order to speed up error printing.  */
  87           static char *line;
  88           static size_t allocated = 0, index = 0;
  89
  90           if (index + 1 >= allocated)
  91             {
  92               allocated = allocated ? allocated * 2 : 1000;
  93               line = xrealloc (line, allocated);
  94             }
  95           line[index++] = c;
  96           if (c == '\n')
  97             {
  98               line[index] = '\0';
  99               fputs (line, stderr);
 100               index = 0;
 101             }
 102         }
 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 {
 112   while (*p)
 113     error_char (*p++);
 114 }
 115
 116
 117 /* Show the file, where it was included and the source line, give a
 118    locus.  Calls error_printf() recursively, but the recursion is at
 119    most one level deep.  */
 120
 121 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 122
 123 static void
 124 show_locus (int offset, locus * loc)
 125 {
 126   gfc_linebuf *lb;
 127   gfc_file *f;
 128   char c, *p;
 129   int i, m;
 130
 131   /* TODO: Either limit the total length and number of included files
 132      displayed or add buffering of arbitrary number of characters in
 133      error messages.  */
 134
 135   lb = loc->lb;
 136   f = lb->file;
 137   error_printf ("%s:%d:\n", f->filename,
 138 #ifdef USE_MAPPED_LOCATION
 139                 LOCATION_LINE (lb->location)
 140 #else
 141                 lb->linenum
 142 #endif
 143                 );
 144
 145   for (;;)
 146     {
 147       i = f->inclusion_line;
 148
 149       f = f->included_by;
 150       if (f == NULL) break;
 151
 152       error_printf ("    Included at %s:%d\n", f->filename, i);
 153     }
 154
 155   /* Show the line itself, taking care not to print more than what can
 156      show up on the terminal.  Tabs are converted to spaces.  */
 157
 158   p = lb->line + offset;
 159   i = strlen (p);
 160   if (i > terminal_width)
 161     i = terminal_width - 1;
 162
 163   for (; i > 0; i--)
 164     {
 165       c = *p++;
 166       if (c == '\t')
 167         c = ' ';
 168
 169       if (ISPRINT (c))
 170         error_char (c);
 171       else
 172         {
 173           error_char ('\\');
 174           error_char ('x');
 175
 176           m = ((c >> 4) & 0x0F) + '0';
 177           if (m > '9')
 178             m += 'A' - '9' - 1;
 179           error_char (m);
 180
 181           m = (c & 0x0F) + '0';
 182           if (m > '9')
 183             m += 'A' - '9' - 1;
 184           error_char (m);
 185         }
 186     }
 187
 188   error_char ('\n');
 189 }
 190
 191
 192 /* As part of printing an error, we show the source lines that caused
 193    the problem.  We show at least one, possibly two loci.  If we're
 194    showing two loci and they both refer to the same file and line, we
 195    only print the line once.  */
 196
 197 static void
 198 show_loci (locus * l1, locus * l2)
 199 {
 200   int offset, flag, i, m, c1, c2, cmax;
 201
 202   if (l1 == NULL || l1->lb == NULL)
 203     {
 204       error_printf ("<During initialization>\n");
 205       return;
 206     }
 207
 208   c1 = l1->nextc - l1->lb->line;
 209   c2 = 0;
 210   if (l2 == NULL)
 211     goto separate;
 212
 213   c2 = l2->nextc - l2->lb->line;
 214
 215   if (c1 < c2)
 216     m = c2 - c1;
 217   else
 218     m = c1 - c2;
 219
 220
 221   if (l1->lb != l2->lb || m > terminal_width - 10)
 222     goto separate;
 223
 224   offset = 0;
 225   cmax = (c1 < c2) ? c2 : c1;
 226   if (cmax > terminal_width - 5)
 227     offset = cmax - terminal_width + 5;
 228
 229   if (offset < 0)
 230     offset = 0;
 231
 232   c1 -= offset;
 233   c2 -= offset;
 234
 235   show_locus (offset, l1);
 236
 237   /* Arrange that '1' and '2' will show up even if the two columns are equal.  */
 238   for (i = 1; i <= cmax; i++)
 239     {
 240       flag = 0;
 241       if (i == c1)
 242         {
 243           error_char ('1');
 244           flag = 1;
 245         }
 246       if (i == c2)
 247         {
 248           error_char ('2');
 249           flag = 1;
 250         }
 251       if (flag == 0)
 252         error_char (' ');
 253     }
 254
 255   error_char ('\n');
 256
 257   return;
 258
 259 separate:
 260   offset = 0;
 261
 262   if (c1 > terminal_width - 5)
 263     {
 264       offset = c1 - 5;
 265       if (offset < 0)
 266         offset = 0;
 267       c1 = c1 - offset;
 268     }
 269
 270   show_locus (offset, l1);
 271   for (i = 1; i < c1; i++)
 272     error_char (' ');
 273
 274   error_char ('1');
 275   error_char ('\n');
 276
 277   if (l2 != NULL)
 278     {
 279       offset = 0;
 280
 281       if (c2 > terminal_width - 20)
 282         {
 283           offset = c2 - 20;
 284           if (offset < 0)
 285             offset = 0;
 286           c2 = c2 - offset;
 287         }
 288
 289       show_locus (offset, l2);
 290
 291       for (i = 1; i < c2; i++)
 292         error_char (' ');
 293
 294       error_char ('2');
 295       error_char ('\n');
 296     }
 297 }
 298
 299
 300 /* Workhorse for the error printing subroutines.  This subroutine is
 301    inspired by g77's error handling and is similar to printf() with
 302    the following %-codes:
 303
 304    %c Character, %d Integer, %s String, %% Percent
 305    %L  Takes locus argument
 306    %C  Current locus (no argument)
 307
 308    If a locus pointer is given, the actual source line is printed out
 309    and the column is indicated.  Since we want the error message at
 310    the bottom of any source file information, we must scan the
 311    argument list twice.  A maximum of two locus arguments are
 312    permitted.  */
 313
 314 #define IBUF_LEN 30
 315 #define MAX_ARGS 10
 316
 317 static void ATTRIBUTE_GCC_GFC(2,0)
 318 error_print (const char *type, const char *format0, va_list argp)
 319 {
 320   char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS];
 321   int i, n, have_l1, i_arg[MAX_ARGS];
 322   locus *l1, *l2, *loc;
 323   const char *format;
 324
 325   l1 = l2 = loc = NULL;
 326
 327   have_l1 = 0;
 328
 329   n = 0;
 330   format = format0;
 331
 332   while (*format)
 333     {
 334       c = *format++;
 335       if (c == '%')
 336         {
 337           c = *format++;
 338
 339           switch (c)
 340             {
 341             case '%':
 342               break;
 343
 344             case 'L':
 345               loc = va_arg (argp, locus *);
 346               /* Fall through */
 347
 348             case 'C':
 349               if (c == 'C')
 350                 loc = &gfc_current_locus;
 351
 352               if (have_l1)
 353                 {
 354                   l2 = loc;
 355                 }
 356               else
 357                 {
 358                   l1 = loc;
 359                   have_l1 = 1;
 360                 }
 361               break;
 362
 363             case 'd':
 364             case 'i':
 365               i_arg[n++] = va_arg (argp, int);
 366               break;
 367
 368             case 'c':
 369               c_arg[n++] = va_arg (argp, int);
 370               break;
 371
 372             case 's':
 373               cp_arg[n++] = va_arg (argp, char *);
 374               break;
 375             }
 376         }
 377     }
 378
 379   /* Show the current loci if we have to.  */
 380   if (have_l1)
 381     show_loci (l1, l2);
 382   error_string (type);
 383   if (*type)
 384     error_char (' ');
 385
 386   have_l1 = 0;
 387   format = format0;
 388   n = 0;
 389
 390   for (; *format; format++)
 391     {
 392       if (*format != '%')
 393         {
 394           error_char (*format);
 395           continue;
 396         }
 397
 398       format++;
 399       switch (*format)
 400         {
 401         case '%':
 402           error_char ('%');
 403           break;
 404
 405         case 'c':
 406           error_char (c_arg[n++]);
 407           break;
 408
 409         case 's':
 410           error_string (cp_arg[n++]);
 411           break;
 412
 413         case 'i':
 414         case 'd':
 415           i = i_arg[n++];
 416
 417           if (i < 0)
 418             {
 419               i = -i;
 420               error_char ('-');
 421             }
 422
 423           p = int_buf + IBUF_LEN - 1;
 424           *p-- = '\0';
 425
 426           if (i == 0)
 427             *p-- = '0';
 428
 429           while (i > 0)
 430             {
 431               *p-- = i % 10 + '0';
 432               i = i / 10;
 433             }
 434
 435           error_string (p + 1);
 436           break;
 437
 438         case 'C':               /* Current locus */
 439         case 'L':               /* Specified locus */
 440           error_string (have_l1 ? "(2)" : "(1)");
 441           have_l1 = 1;
 442           break;
 443         }
 444     }
 445
 446   error_char ('\n');
 447 }
 448
 449
 450 /* Wrapper for error_print().  */
 451
 452 static void
 453 error_printf (const char *nocmsgid, ...)
 454 {
 455   va_list argp;
 456
 457   va_start (argp, nocmsgid);
 458   error_print ("", _(nocmsgid), argp);
 459   va_end (argp);
 460 }
 461
 462
 463 /* Issue a warning.  */
 464
 465 void
 466 gfc_warning (const char *nocmsgid, ...)
 467 {
 468   va_list argp;
 469
 470   if (inhibit_warnings)
 471     return;
 472
 473   warning_buffer.flag = 1;
 474   warning_buffer.index = 0;
 475   cur_error_buffer = &warning_buffer;
 476
 477   va_start (argp, nocmsgid);
 478   if (buffer_flag == 0)
 479   {
 480     warnings++;
 481     if (warnings_are_errors)
 482       errors++;
 483   }
 484
 485   error_print (_("Warning:"), _(nocmsgid), argp);
 486   va_end (argp);
 487
 488   error_char ('\0');
 489 }
 490
 491
 492 /* Whether, for a feature included in a given standard set (GFC_STD_*),
 493    we should issue an error or a warning, or be quiet.  */
 494
 495 notification
 496 gfc_notification_std (int std)
 497 {
 498   bool warning;
 499
 500   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
 501   if ((gfc_option.allow_std & std) != 0 && !warning)
 502     return SILENT;
 503
 504   return warning ? WARNING : ERROR;
 505 }
 506
 507
 508 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
 509    feature.  An error/warning will be issued if the currently selected
 510    standard does not contain the requested bits.  Return FAILURE if
 511    an error is generated.  */
 512
 513 try
 514 gfc_notify_std (int std, const char *nocmsgid, ...)
 515 {
 516   va_list argp;
 517   bool warning;
 518
 519   warning = ((gfc_option.warn_std & std) != 0)
 520             && !inhibit_warnings;
 521   if ((gfc_option.allow_std & std) != 0
 522       && !warning)
 523     return SUCCESS;
 524
 525   if (gfc_suppress_error)
 526     return warning ? SUCCESS : FAILURE;
 527
 528   cur_error_buffer = (warning && !warnings_are_errors)
 529     ? &warning_buffer : &error_buffer;
 530   cur_error_buffer->flag = 1;
 531   cur_error_buffer->index = 0;
 532
 533   if (buffer_flag == 0)
 534     {
 535       if (warning && !warnings_are_errors)
 536         warnings++;
 537       else
 538         errors++;
 539     }
 540   va_start (argp, nocmsgid);
 541   if (warning)
 542     error_print (_("Warning:"), _(nocmsgid), argp);
 543   else
 544     error_print (_("Error:"), _(nocmsgid), argp);
 545   va_end (argp);
 546
 547   error_char ('\0');
 548   return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
 549 }
 550
 551
 552 /* Immediate warning (i.e. do not buffer the warning).  */
 553
 554 void
 555 gfc_warning_now (const char *nocmsgid, ...)
 556 {
 557   va_list argp;
 558   int i;
 559
 560   if (inhibit_warnings)
 561     return;
 562
 563   i = buffer_flag;
 564   buffer_flag = 0;
 565   warnings++;
 566   if (warnings_are_errors)
 567     errors++;
 568
 569   va_start (argp, nocmsgid);
 570   error_print (_("Warning:"), _(nocmsgid), argp);
 571   va_end (argp);
 572
 573   error_char ('\0');
 574   buffer_flag = i;
 575 }
 576
 577
 578 /* Clear the warning flag.  */
 579
 580 void
 581 gfc_clear_warning (void)
 582 {
 583   warning_buffer.flag = 0;
 584 }
 585
 586
 587 /* Check to see if any warnings have been saved.
 588    If so, print the warning.  */
 589
 590 void
 591 gfc_warning_check (void)
 592 {
 593   if (warning_buffer.flag)
 594     {
 595       warnings++;
 596       if (warning_buffer.message != NULL)
 597         fputs (warning_buffer.message, stderr);
 598       warning_buffer.flag = 0;
 599     }
 600 }
 601
 602
 603 /* Issue an error.  */
 604
 605 void
 606 gfc_error (const char *nocmsgid, ...)
 607 {
 608   va_list argp;
 609
 610   if (gfc_suppress_error)
 611     return;
 612
 613   error_buffer.flag = 1;
 614   error_buffer.index = 0;
 615   cur_error_buffer = &error_buffer;
 616
 617   va_start (argp, nocmsgid);
 618   if (buffer_flag == 0)
 619     errors++;
 620   error_print (_("Error:"), _(nocmsgid), argp);
 621   va_end (argp);
 622
 623   error_char ('\0');
 624 }
 625
 626
 627 /* Immediate error.  */
 628
 629 void
 630 gfc_error_now (const char *nocmsgid, ...)
 631 {
 632   va_list argp;
 633   int i;
 634
 635   error_buffer.flag = 1;
 636   error_buffer.index = 0;
 637   cur_error_buffer = &error_buffer;
 638
 639   i = buffer_flag;
 640   buffer_flag = 0;
 641   errors++;
 642
 643   va_start (argp, nocmsgid);
 644   error_print (_("Error:"), _(nocmsgid), argp);
 645   va_end (argp);
 646
 647   error_char ('\0');
 648   buffer_flag = i;
 649
 650   if (flag_fatal_errors)
 651     exit (1);
 652 }
 653
 654
 655 /* Fatal error, never returns.  */
 656
 657 void
 658 gfc_fatal_error (const char *nocmsgid, ...)
 659 {
 660   va_list argp;
 661
 662   buffer_flag = 0;
 663
 664   va_start (argp, nocmsgid);
 665   error_print (_("Fatal Error:"), _(nocmsgid), argp);
 666   va_end (argp);
 667
 668   exit (3);
 669 }
 670
 671
 672 /* This shouldn't happen... but sometimes does.  */
 673
 674 void
 675 gfc_internal_error (const char *format, ...)
 676 {
 677   va_list argp;
 678
 679   buffer_flag = 0;
 680
 681   va_start (argp, format);
 682
 683   show_loci (&gfc_current_locus, NULL);
 684   error_printf ("Internal Error at (1):");
 685
 686   error_print ("", format, argp);
 687   va_end (argp);
 688
 689   exit (ICE_EXIT_CODE);
 690 }
 691
 692
 693 /* Clear the error flag when we start to compile a source line.  */
 694
 695 void
 696 gfc_clear_error (void)
 697 {
 698   error_buffer.flag = 0;
 699 }
 700
 701
 702 /* Check to see if any errors have been saved.
 703    If so, print the error.  Returns the state of error_flag.  */
 704
 705 int
 706 gfc_error_check (void)
 707 {
 708   int rc;
 709
 710   rc = error_buffer.flag;
 711
 712   if (error_buffer.flag)
 713     {
 714       errors++;
 715       if (error_buffer.message != NULL)
 716         fputs (error_buffer.message, stderr);
 717       error_buffer.flag = 0;
 718
 719       if (flag_fatal_errors)
 720         exit (1);
 721     }
 722
 723   return rc;
 724 }
 725
 726
 727 /* Save the existing error state.  */
 728
 729 void
 730 gfc_push_error (gfc_error_buf * err)
 731 {
 732   err->flag = error_buffer.flag;
 733   if (error_buffer.flag)
 734     err->message = xstrdup (error_buffer.message);
 735
 736   error_buffer.flag = 0;
 737 }
 738
 739
 740 /* Restore a previous pushed error state.  */
 741
 742 void
 743 gfc_pop_error (gfc_error_buf * err)
 744 {
 745   error_buffer.flag = err->flag;
 746   if (error_buffer.flag)
 747     {
 748       size_t len = strlen (err->message) + 1;
 749       gcc_assert (len <= error_buffer.allocated);
 750       memcpy (error_buffer.message, err->message, len);
 751       gfc_free (err->message);
 752     }
 753 }
 754
 755
 756 /* Free a pushed error state, but keep the current error state.  */
 757
 758 void
 759 gfc_free_error (gfc_error_buf * err)
 760 {
 761   if (err->flag)
 762     gfc_free (err->message);
 763 }
 764
 765
 766 /* Debug wrapper for printf.  */
 767
 768 void
 769 gfc_status (const char *cmsgid, ...)
 770 {
 771   va_list argp;
 772
 773   va_start (argp, cmsgid);
 774
 775   vprintf (_(cmsgid), argp);
 776
 777   va_end (argp);
 778 }
 779
 780
 781 /* Subroutine for outputting a single char so that we don't have to go
 782    around creating a lot of 1-character strings.  */
 783
 784 void
 785 gfc_status_char (char c)
 786 {
 787   putchar (c);
 788 }
 789
 790
 791 /* Report the number of warnings and errors that occurred to the caller.  */
 792
 793 void
 794 gfc_get_errors (int *w, int *e)
 795 {
 796   if (w != NULL)
 797     *w = warnings;
 798   if (e != NULL)
 799     *e = errors;
 800 }