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