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 ("In file %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)
 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   error_char (' ');
 384
 385   have_l1 = 0;
 386   format = format0;
 387   n = 0;
 388
 389   for (; *format; format++)
 390     {
 391       if (*format != '%')
 392         {
 393           error_char (*format);
 394           continue;
 395         }
 396
 397       format++;
 398       switch (*format)
 399         {
 400         case '%':
 401           error_char ('%');
 402           break;
 403
 404         case 'c':
 405           error_char (c_arg[n++]);
 406           break;
 407
 408         case 's':
 409           error_string (cp_arg[n++]);
 410           break;
 411
 412         case 'i':
 413         case 'd':
 414           i = i_arg[n++];
 415
 416           if (i < 0)
 417             {
 418               i = -i;
 419               error_char ('-');
 420             }
 421
 422           p = int_buf + IBUF_LEN - 1;
 423           *p-- = '\0';
 424
 425           if (i == 0)
 426             *p-- = '0';
 427
 428           while (i > 0)
 429             {
 430               *p-- = i % 10 + '0';
 431               i = i / 10;
 432             }
 433
 434           error_string (p + 1);
 435           break;
 436
 437         case 'C':               /* Current locus */
 438         case 'L':               /* Specified locus */
 439           error_string (have_l1 ? "(2)" : "(1)");
 440           have_l1 = 1;
 441           break;
 442         }
 443     }
 444
 445   error_char ('\n');
 446 }
 447
 448
 449 /* Wrapper for error_print().  */
 450
 451 static void
 452 error_printf (const char *nocmsgid, ...)
 453 {
 454   va_list argp;
 455
 456   va_start (argp, nocmsgid);
 457   error_print ("", _(nocmsgid), argp);
 458   va_end (argp);
 459 }
 460
 461
 462 /* Issue a warning.  */
 463
 464 void
 465 gfc_warning (const char *nocmsgid, ...)
 466 {
 467   va_list argp;
 468
 469   if (inhibit_warnings)
 470     return;
 471
 472   warning_buffer.flag = 1;
 473   warning_buffer.index = 0;
 474   cur_error_buffer = &warning_buffer;
 475
 476   va_start (argp, nocmsgid);
 477   if (buffer_flag == 0)
 478     warnings++;
 479   error_print (_("Warning:"), _(nocmsgid), argp);
 480   va_end (argp);
 481
 482   error_char ('\0');
 483 }
 484
 485
 486 /* Whether, for a feature included in a given standard set (GFC_STD_*),
 487    we should issue an error or a warning, or be quiet.  */
 488
 489 notification
 490 gfc_notification_std (int std)
 491 {
 492   bool warning;
 493
 494   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
 495   if ((gfc_option.allow_std & std) != 0 && !warning)
 496     return SILENT;
 497
 498   return warning ? WARNING : ERROR;
 499 }
 500
 501
 502 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
 503    feature.  An error/warning will be issued if the currently selected
 504    standard does not contain the requested bits.  Return FAILURE if
 505    an error is generated.  */
 506
 507 try
 508 gfc_notify_std (int std, const char *nocmsgid, ...)
 509 {
 510   va_list argp;
 511   bool warning;
 512
 513   warning = ((gfc_option.warn_std & std) != 0)
 514             && !inhibit_warnings;
 515   if ((gfc_option.allow_std & std) != 0
 516       && !warning)
 517     return SUCCESS;
 518
 519   if (gfc_suppress_error)
 520     return warning ? SUCCESS : FAILURE;
 521
 522   cur_error_buffer = warning ? &warning_buffer : &error_buffer;
 523   cur_error_buffer->flag = 1;
 524   cur_error_buffer->index = 0;
 525
 526   if (buffer_flag == 0)
 527     {
 528       if (warning)
 529         warnings++;
 530       else
 531         errors++;
 532     }
 533   va_start (argp, nocmsgid);
 534   if (warning)
 535     error_print (_("Warning:"), _(nocmsgid), argp);
 536   else
 537     error_print (_("Error:"), _(nocmsgid), argp);
 538   va_end (argp);
 539
 540   error_char ('\0');
 541   return warning ? SUCCESS : FAILURE;
 542 }
 543
 544
 545 /* Immediate warning (i.e. do not buffer the warning).  */
 546
 547 void
 548 gfc_warning_now (const char *nocmsgid, ...)
 549 {
 550   va_list argp;
 551   int i;
 552
 553   if (inhibit_warnings)
 554     return;
 555
 556   i = buffer_flag;
 557   buffer_flag = 0;
 558   warnings++;
 559
 560   va_start (argp, nocmsgid);
 561   error_print (_("Warning:"), _(nocmsgid), argp);
 562   va_end (argp);
 563
 564   error_char ('\0');
 565   buffer_flag = i;
 566 }
 567
 568
 569 /* Clear the warning flag.  */
 570
 571 void
 572 gfc_clear_warning (void)
 573 {
 574   warning_buffer.flag = 0;
 575 }
 576
 577
 578 /* Check to see if any warnings have been saved.
 579    If so, print the warning.  */
 580
 581 void
 582 gfc_warning_check (void)
 583 {
 584   if (warning_buffer.flag)
 585     {
 586       warnings++;
 587       if (warning_buffer.message != NULL)
 588         fputs (warning_buffer.message, stderr);
 589       warning_buffer.flag = 0;
 590     }
 591 }
 592
 593
 594 /* Issue an error.  */
 595
 596 void
 597 gfc_error (const char *nocmsgid, ...)
 598 {
 599   va_list argp;
 600
 601   if (gfc_suppress_error)
 602     return;
 603
 604   error_buffer.flag = 1;
 605   error_buffer.index = 0;
 606   cur_error_buffer = &error_buffer;
 607
 608   va_start (argp, nocmsgid);
 609   if (buffer_flag == 0)
 610     errors++;
 611   error_print (_("Error:"), _(nocmsgid), argp);
 612   va_end (argp);
 613
 614   error_char ('\0');
 615 }
 616
 617
 618 /* Immediate error.  */
 619
 620 void
 621 gfc_error_now (const char *nocmsgid, ...)
 622 {
 623   va_list argp;
 624   int i;
 625
 626   error_buffer.flag = 1;
 627   error_buffer.index = 0;
 628   cur_error_buffer = &error_buffer;
 629
 630   i = buffer_flag;
 631   buffer_flag = 0;
 632   errors++;
 633
 634   va_start (argp, nocmsgid);
 635   error_print (_("Error:"), _(nocmsgid), argp);
 636   va_end (argp);
 637
 638   error_char ('\0');
 639   buffer_flag = i;
 640
 641   if (flag_fatal_errors)
 642     exit (1);
 643 }
 644
 645
 646 /* Fatal error, never returns.  */
 647
 648 void
 649 gfc_fatal_error (const char *nocmsgid, ...)
 650 {
 651   va_list argp;
 652
 653   buffer_flag = 0;
 654
 655   va_start (argp, nocmsgid);
 656   error_print (_("Fatal Error:"), _(nocmsgid), argp);
 657   va_end (argp);
 658
 659   exit (3);
 660 }
 661
 662
 663 /* This shouldn't happen... but sometimes does.  */
 664
 665 void
 666 gfc_internal_error (const char *format, ...)
 667 {
 668   va_list argp;
 669
 670   buffer_flag = 0;
 671
 672   va_start (argp, format);
 673
 674   show_loci (&gfc_current_locus, NULL);
 675   error_printf ("Internal Error at (1):");
 676
 677   error_print ("", format, argp);
 678   va_end (argp);
 679
 680   exit (ICE_EXIT_CODE);
 681 }
 682
 683
 684 /* Clear the error flag when we start to compile a source line.  */
 685
 686 void
 687 gfc_clear_error (void)
 688 {
 689   error_buffer.flag = 0;
 690 }
 691
 692
 693 /* Check to see if any errors have been saved.
 694    If so, print the error.  Returns the state of error_flag.  */
 695
 696 int
 697 gfc_error_check (void)
 698 {
 699   int rc;
 700
 701   rc = error_buffer.flag;
 702
 703   if (error_buffer.flag)
 704     {
 705       errors++;
 706       if (error_buffer.message != NULL)
 707         fputs (error_buffer.message, stderr);
 708       error_buffer.flag = 0;
 709
 710       if (flag_fatal_errors)
 711         exit (1);
 712     }
 713
 714   return rc;
 715 }
 716
 717
 718 /* Save the existing error state.  */
 719
 720 void
 721 gfc_push_error (gfc_error_buf * err)
 722 {
 723   err->flag = error_buffer.flag;
 724   if (error_buffer.flag)
 725     err->message = xstrdup (error_buffer.message);
 726
 727   error_buffer.flag = 0;
 728 }
 729
 730
 731 /* Restore a previous pushed error state.  */
 732
 733 void
 734 gfc_pop_error (gfc_error_buf * err)
 735 {
 736   error_buffer.flag = err->flag;
 737   if (error_buffer.flag)
 738     {
 739       size_t len = strlen (err->message) + 1;
 740       gcc_assert (len <= error_buffer.allocated);
 741       memcpy (error_buffer.message, err->message, len);
 742       gfc_free (err->message);
 743     }
 744 }
 745
 746
 747 /* Free a pushed error state, but keep the current error state.  */
 748
 749 void
 750 gfc_free_error (gfc_error_buf * err)
 751 {
 752   if (err->flag)
 753     gfc_free (err->message);
 754 }
 755
 756
 757 /* Debug wrapper for printf.  */
 758
 759 void
 760 gfc_status (const char *cmsgid, ...)
 761 {
 762   va_list argp;
 763
 764   va_start (argp, cmsgid);
 765
 766   vprintf (_(cmsgid), argp);
 767
 768   va_end (argp);
 769 }
 770
 771
 772 /* Subroutine for outputting a single char so that we don't have to go
 773    around creating a lot of 1-character strings.  */
 774
 775 void
 776 gfc_status_char (char c)
 777 {
 778   putchar (c);
 779 }
 780
 781
 782 /* Report the number of warnings and errors that occurred to the caller.  */
 783
 784 void
 785 gfc_get_errors (int *w, int *e)
 786 {
 787   if (w != NULL)
 788     *w = warnings;
 789   if (e != NULL)
 790     *e = errors;
 791 }