gcc/fortran/error.c

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