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