gcc/fortran/error.c

   1 /* Handle errors.
   2    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   3    Free Software 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 3, 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 COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 /* Handle the inevitable errors.  A major catch here is that things
  23    flagged as errors in one match subroutine can conceivably be legal
  24    elsewhere.  This means that error messages are recorded and saved
  25    for possible use later.  If a line does not match a legal
  26    construction, then the saved error message is reported.  */
  27
  28 #include "config.h"
  29 #include "system.h"
  30 #include "flags.h"
  31 #include "gfortran.h"
  32
  33 int gfc_suppress_error = 0;
  34
  35 static int terminal_width, buffer_flag, errors, warnings;
  36
  37 static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
  38
  39
  40 /* Per-file error initialization.  */
  41
  42 void
  43 gfc_error_init_1 (void)
  44 {
  45   terminal_width = gfc_terminal_width ();
  46   errors = 0;
  47   warnings = 0;
  48   buffer_flag = 0;
  49 }
  50
  51
  52 /* Set the flag for buffering errors or not.  */
  53
  54 void
  55 gfc_buffer_error (int flag)
  56 {
  57   buffer_flag = flag;
  58 }
  59
  60
  61 /* Add a single character to the error buffer or output depending on
  62    buffer_flag.  */
  63
  64 static void
  65 error_char (char c)
  66 {
  67   if (buffer_flag)
  68     {
  69       if (cur_error_buffer->index >= cur_error_buffer->allocated)
  70         {
  71           cur_error_buffer->allocated = cur_error_buffer->allocated
  72                                       ? cur_error_buffer->allocated * 2 : 1000;
  73           cur_error_buffer->message = xrealloc (cur_error_buffer->message,
  74                                                 cur_error_buffer->allocated);
  75         }
  76       cur_error_buffer->message[cur_error_buffer->index++] = c;
  77     }
  78   else
  79     {
  80       if (c != 0)
  81         {
  82           /* We build up complete lines before handing things
  83              over to the library in order to speed up error printing.  */
  84           static char *line;
  85           static size_t allocated = 0, index = 0;
  86
  87           if (index + 1 >= allocated)
  88             {
  89               allocated = allocated ? allocated * 2 : 1000;
  90               line = xrealloc (line, allocated);
  91             }
  92           line[index++] = c;
  93           if (c == '\n')
  94             {
  95               line[index] = '\0';
  96               fputs (line, stderr);
  97               index = 0;
  98             }
  99         }
 100     }
 101 }
 102
 103
 104 /* Copy a string to wherever it needs to go.  */
 105
 106 static void
 107 error_string (const char *p)
 108 {
 109   while (*p)
 110     error_char (*p++);
 111 }
 112
 113
 114 /* Print a formatted integer to the error buffer or output.  */
 115
 116 #define IBUF_LEN 60
 117
 118 static void
 119 error_uinteger (unsigned long int i)
 120 {
 121   char *p, int_buf[IBUF_LEN];
 122
 123   p = int_buf + IBUF_LEN - 1;
 124   *p-- = '\0';
 125
 126   if (i == 0)
 127     *p-- = '0';
 128
 129   while (i > 0)
 130     {
 131       *p-- = i % 10 + '0';
 132       i = i / 10;
 133     }
 134
 135   error_string (p + 1);
 136 }
 137
 138 static void
 139 error_integer (long int i)
 140 {
 141   unsigned long int u;
 142
 143   if (i < 0)
 144     {
 145       u = (unsigned long int) -i;
 146       error_char ('-');
 147     }
 148   else
 149     u = i;
 150
 151   error_uinteger (u);
 152 }
 153
 154
 155 /* Show the file, where it was included, and the source line, give a
 156    locus.  Calls error_printf() recursively, but the recursion is at
 157    most one level deep.  */
 158
 159 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 160
 161 static void
 162 show_locus (locus *loc, int c1, int c2)
 163 {
 164   gfc_linebuf *lb;
 165   gfc_file *f;
 166   char c, *p;
 167   int i, m, offset, cmax;
 168
 169   /* TODO: Either limit the total length and number of included files
 170      displayed or add buffering of arbitrary number of characters in
 171      error messages.  */
 172
 173   /* Write out the error header line, giving the source file and error
 174      location (in GNU standard "[file]:[line].[column]:" format),
 175      followed by an "included by" stack and a blank line.  This header
 176      format is matched by a testsuite parser defined in
 177      lib/gfortran-dg.exp.  */
 178
 179   lb = loc->lb;
 180   f = lb->file;
 181
 182   error_string (f->filename);
 183   error_char (':');
 184
 185   error_integer (LOCATION_LINE (lb->location));
 186
 187   if ((c1 > 0) || (c2 > 0))
 188     error_char ('.');
 189
 190   if (c1 > 0)
 191     error_integer (c1);
 192
 193   if ((c1 > 0) && (c2 > 0))
 194     error_char ('-');
 195
 196   if (c2 > 0)
 197     error_integer (c2);
 198
 199   error_char (':');
 200   error_char ('\n');
 201
 202   for (;;)
 203     {
 204       i = f->inclusion_line;
 205
 206       f = f->up;
 207       if (f == NULL) break;
 208
 209       error_printf ("    Included at %s:%d:", f->filename, i);
 210     }
 211
 212   error_char ('\n');
 213
 214   /* Calculate an appropriate horizontal offset of the source line in
 215      order to get the error locus within the visible portion of the
 216      line.  Note that if the margin of 5 here is changed, the
 217      corresponding margin of 10 in show_loci should be changed.  */
 218
 219   offset = 0;
 220
 221   /* When the loci is not associated with a column, it will have a
 222      value of zero.  We adjust this to 1 so that it will appear.  */
 223
 224   if (c1 == 0)
 225     c1 = 1;
 226   if (c2 == 0)
 227     c2 = 1;
 228
 229   /* If the two loci would appear in the same column, we shift
 230      '2' one column to the right, so as to print '12' rather than
 231      just '1'.  We do this here so it will be accounted for in the
 232      margin calculations.  */
 233
 234   if (c1 == c2)
 235     c2 += 1;
 236
 237   cmax = (c1 < c2) ? c2 : c1;
 238   if (cmax > terminal_width - 5)
 239     offset = cmax - terminal_width + 5;
 240
 241   /* Show the line itself, taking care not to print more than what can
 242      show up on the terminal.  Tabs are converted to spaces, and
 243      nonprintable characters are converted to a "\xNN" sequence.  */
 244
 245   /* TODO: Although setting i to the terminal width is clever, it fails
 246      to work correctly when nonprintable characters exist.  A better
 247      solution should be found.  */
 248
 249   p = lb->line + offset;
 250   i = strlen (p);
 251   if (i > terminal_width)
 252     i = terminal_width - 1;
 253
 254   for (; i > 0; i--)
 255     {
 256       c = *p++;
 257       if (c == '\t')
 258         c = ' ';
 259
 260       if (ISPRINT (c))
 261         error_char (c);
 262       else
 263         {
 264           error_char ('\\');
 265           error_char ('x');
 266
 267           m = ((c >> 4) & 0x0F) + '0';
 268           if (m > '9')
 269             m += 'A' - '9' - 1;
 270           error_char (m);
 271
 272           m = (c & 0x0F) + '0';
 273           if (m > '9')
 274             m += 'A' - '9' - 1;
 275           error_char (m);
 276         }
 277     }
 278
 279   error_char ('\n');
 280
 281   /* Show the '1' and/or '2' corresponding to the column of the error
 282      locus.  Note that a value of -1 for c1 or c2 will simply cause
 283      the relevant number not to be printed.  */
 284
 285   c1 -= offset;
 286   c2 -= offset;
 287
 288   for (i = 1; i <= cmax; i++)
 289     {
 290       if (i == c1)
 291         error_char ('1');
 292       else if (i == c2)
 293         error_char ('2');
 294       else
 295         error_char (' ');
 296     }
 297
 298   error_char ('\n');
 299
 300 }
 301
 302
 303 /* As part of printing an error, we show the source lines that caused
 304    the problem.  We show at least one, and possibly two loci; the two
 305    loci may or may not be on the same source line.  */
 306
 307 static void
 308 show_loci (locus *l1, locus *l2)
 309 {
 310   int m, c1, c2;
 311
 312   if (l1 == NULL || l1->lb == NULL)
 313     {
 314       error_printf ("<During initialization>\n");
 315       return;
 316     }
 317
 318   /* While calculating parameters for printing the loci, we consider possible
 319      reasons for printing one per line.  If appropriate, print the loci
 320      individually; otherwise we print them both on the same line.  */
 321
 322   c1 = l1->nextc - l1->lb->line;
 323   if (l2 == NULL)
 324     {
 325       show_locus (l1, c1, -1);
 326       return;
 327     }
 328
 329   c2 = l2->nextc - l2->lb->line;
 330
 331   if (c1 < c2)
 332     m = c2 - c1;
 333   else
 334     m = c1 - c2;
 335
 336   /* Note that the margin value of 10 here needs to be less than the
 337      margin of 5 used in the calculation of offset in show_locus.  */
 338
 339   if (l1->lb != l2->lb || m > terminal_width - 10)
 340     {
 341       show_locus (l1, c1, -1);
 342       show_locus (l2, -1, c2);
 343       return;
 344     }
 345
 346   show_locus (l1, c1, c2);
 347
 348   return;
 349 }
 350
 351
 352 /* Workhorse for the error printing subroutines.  This subroutine is
 353    inspired by g77's error handling and is similar to printf() with
 354    the following %-codes:
 355
 356    %c Character, %d or %i Integer, %s String, %% Percent
 357    %L  Takes locus argument
 358    %C  Current locus (no argument)
 359
 360    If a locus pointer is given, the actual source line is printed out
 361    and the column is indicated.  Since we want the error message at
 362    the bottom of any source file information, we must scan the
 363    argument list twice -- once to determine whether the loci are
 364    present and record this for printing, and once to print the error
 365    message after and loci have been printed.  A maximum of two locus
 366    arguments are permitted.
 367
 368    This function is also called (recursively) by show_locus in the
 369    case of included files; however, as show_locus does not resupply
 370    any loci, the recursion is at most one level deep.  */
 371
 372 #define MAX_ARGS 10
 373
 374 static void ATTRIBUTE_GCC_GFC(2,0)
 375 error_print (const char *type, const char *format0, va_list argp)
 376 {
 377   enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
 378          TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
 379          NOTYPE };
 380   struct
 381   {
 382     int type;
 383     int pos;
 384     union
 385     {
 386       int intval;
 387       unsigned int uintval;
 388       long int longintval;
 389       unsigned long int ulongintval;
 390       char charval;
 391       const char * stringval;
 392     } u;
 393   } arg[MAX_ARGS], spec[MAX_ARGS];
 394   /* spec is the array of specifiers, in the same order as they
 395      appear in the format string.  arg is the array of arguments,
 396      in the same order as they appear in the va_list.  */
 397
 398   char c;
 399   int i, n, have_l1, pos, maxpos;
 400   locus *l1, *l2, *loc;
 401   const char *format;
 402
 403   l1 = l2 = NULL;
 404
 405   have_l1 = 0;
 406   pos = -1;
 407   maxpos = -1;
 408
 409   n = 0;
 410   format = format0;
 411
 412   for (i = 0; i < MAX_ARGS; i++)
 413     {
 414       arg[i].type = NOTYPE;
 415       spec[i].pos = -1;
 416     }
 417
 418   /* First parse the format string for position specifiers.  */
 419   while (*format)
 420     {
 421       c = *format++;
 422       if (c != '%')
 423         continue;
 424
 425       if (*format == '%')
 426         {
 427           format++;
 428           continue;
 429         }
 430
 431       if (ISDIGIT (*format))
 432         {
 433           /* This is a position specifier.  For example, the number
 434              12 in the format string "%12$d", which specifies the third
 435              argument of the va_list, formatted in %d format.
 436              For details, see "man 3 printf".  */
 437           pos = atoi(format) - 1;
 438           gcc_assert (pos >= 0);
 439           while (ISDIGIT(*format))
 440             format++;
 441           gcc_assert (*format++ == '$');
 442         }
 443       else
 444         pos++;
 445
 446       c = *format++;
 447
 448       if (pos > maxpos)
 449         maxpos = pos;
 450
 451       switch (c)
 452         {
 453           case 'C':
 454             arg[pos].type = TYPE_CURRENTLOC;
 455             break;
 456
 457           case 'L':
 458             arg[pos].type = TYPE_LOCUS;
 459             break;
 460
 461           case 'd':
 462           case 'i':
 463             arg[pos].type = TYPE_INTEGER;
 464             break;
 465
 466           case 'u':
 467             arg[pos].type = TYPE_UINTEGER;
 468
 469           case 'l':
 470             c = *format++;
 471             if (c == 'u')
 472               arg[pos].type = TYPE_ULONGINT;
 473             else if (c == 'i' || c == 'd')
 474               arg[pos].type = TYPE_LONGINT;
 475             else
 476               gcc_unreachable ();
 477             break;
 478
 479           case 'c':
 480             arg[pos].type = TYPE_CHAR;
 481             break;
 482
 483           case 's':
 484             arg[pos].type = TYPE_STRING;
 485             break;
 486
 487           default:
 488             gcc_unreachable ();
 489         }
 490
 491       spec[n++].pos = pos;
 492     }
 493
 494   /* Then convert the values for each %-style argument.  */
 495   for (pos = 0; pos <= maxpos; pos++)
 496     {
 497       gcc_assert (arg[pos].type != NOTYPE);
 498       switch (arg[pos].type)
 499         {
 500           case TYPE_CURRENTLOC:
 501             loc = &gfc_current_locus;
 502             /* Fall through.  */
 503
 504           case TYPE_LOCUS:
 505             if (arg[pos].type == TYPE_LOCUS)
 506               loc = va_arg (argp, locus *);
 507
 508             if (have_l1)
 509               {
 510                 l2 = loc;
 511                 arg[pos].u.stringval = "(2)";
 512               }
 513             else
 514               {
 515                 l1 = loc;
 516                 have_l1 = 1;
 517                 arg[pos].u.stringval = "(1)";
 518               }
 519             break;
 520
 521           case TYPE_INTEGER:
 522             arg[pos].u.intval = va_arg (argp, int);
 523             break;
 524
 525           case TYPE_UINTEGER:
 526             arg[pos].u.uintval = va_arg (argp, unsigned int);
 527             break;
 528
 529           case TYPE_LONGINT:
 530             arg[pos].u.longintval = va_arg (argp, long int);
 531             break;
 532
 533           case TYPE_ULONGINT:
 534             arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
 535             break;
 536
 537           case TYPE_CHAR:
 538             arg[pos].u.charval = (char) va_arg (argp, int);
 539             break;
 540
 541           case TYPE_STRING:
 542             arg[pos].u.stringval = (const char *) va_arg (argp, char *);
 543             break;
 544
 545           default:
 546             gcc_unreachable ();
 547         }
 548     }
 549
 550   for (n = 0; spec[n].pos >= 0; n++)
 551     spec[n].u = arg[spec[n].pos].u;
 552
 553   /* Show the current loci if we have to.  */
 554   if (have_l1)
 555     show_loci (l1, l2);
 556
 557   if (*type)
 558     {
 559       error_string (type);
 560       error_char (' ');
 561     }
 562
 563   have_l1 = 0;
 564   format = format0;
 565   n = 0;
 566
 567   for (; *format; format++)
 568     {
 569       if (*format != '%')
 570         {
 571           error_char (*format);
 572           continue;
 573         }
 574
 575       format++;
 576       if (ISDIGIT (*format))
 577         {
 578           /* This is a position specifier.  See comment above.  */
 579           while (ISDIGIT (*format))
 580             format++;
 581
 582           /* Skip over the dollar sign.  */
 583           format++;
 584         }
 585
 586       switch (*format)
 587         {
 588         case '%':
 589           error_char ('%');
 590           break;
 591
 592         case 'c':
 593           error_char (spec[n++].u.charval);
 594           break;
 595
 596         case 's':
 597         case 'C':               /* Current locus */
 598         case 'L':               /* Specified locus */
 599           error_string (spec[n++].u.stringval);
 600           break;
 601
 602         case 'd':
 603         case 'i':
 604           error_integer (spec[n++].u.intval);
 605           break;
 606
 607         case 'u':
 608           error_uinteger (spec[n++].u.uintval);
 609           break;
 610
 611         case 'l':
 612           format++;
 613           if (*format == 'u')
 614             error_uinteger (spec[n++].u.ulongintval);
 615           else
 616             error_integer (spec[n++].u.longintval);
 617           break;
 618
 619         }
 620     }
 621
 622   error_char ('\n');
 623 }
 624
 625
 626 /* Wrapper for error_print().  */
 627
 628 static void
 629 error_printf (const char *nocmsgid, ...)
 630 {
 631   va_list argp;
 632
 633   va_start (argp, nocmsgid);
 634   error_print ("", _(nocmsgid), argp);
 635   va_end (argp);
 636 }
 637
 638
 639 /* Increment the number of errors, and check whether too many have
 640    been printed.  */
 641
 642 static void
 643 gfc_increment_error_count (void)
 644 {
 645   errors++;
 646   if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
 647     gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
 648 }
 649
 650
 651 /* Issue a warning.  */
 652
 653 void
 654 gfc_warning (const char *nocmsgid, ...)
 655 {
 656   va_list argp;
 657
 658   if (inhibit_warnings)
 659     return;
 660
 661   warning_buffer.flag = 1;
 662   warning_buffer.index = 0;
 663   cur_error_buffer = &warning_buffer;
 664
 665   va_start (argp, nocmsgid);
 666   error_print (_("Warning:"), _(nocmsgid), argp);
 667   va_end (argp);
 668
 669   error_char ('\0');
 670
 671   if (buffer_flag == 0)
 672   {
 673     warnings++;
 674     if (warnings_are_errors)
 675       gfc_increment_error_count();
 676   }
 677 }
 678
 679
 680 /* Whether, for a feature included in a given standard set (GFC_STD_*),
 681    we should issue an error or a warning, or be quiet.  */
 682
 683 notification
 684 gfc_notification_std (int std)
 685 {
 686   bool warning;
 687
 688   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
 689   if ((gfc_option.allow_std & std) != 0 && !warning)
 690     return SILENT;
 691
 692   return warning ? WARNING : ERROR;
 693 }
 694
 695
 696 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
 697    feature.  An error/warning will be issued if the currently selected
 698    standard does not contain the requested bits.  Return FAILURE if
 699    an error is generated.  */
 700
 701 try
 702 gfc_notify_std (int std, const char *nocmsgid, ...)
 703 {
 704   va_list argp;
 705   bool warning;
 706
 707   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
 708   if ((gfc_option.allow_std & std) != 0 && !warning)
 709     return SUCCESS;
 710
 711   if (gfc_suppress_error)
 712     return warning ? SUCCESS : FAILURE;
 713
 714   cur_error_buffer = warning ? &warning_buffer : &error_buffer;
 715   cur_error_buffer->flag = 1;
 716   cur_error_buffer->index = 0;
 717
 718   va_start (argp, nocmsgid);
 719   if (warning)
 720     error_print (_("Warning:"), _(nocmsgid), argp);
 721   else
 722     error_print (_("Error:"), _(nocmsgid), argp);
 723   va_end (argp);
 724
 725   error_char ('\0');
 726
 727   if (buffer_flag == 0)
 728     {
 729       if (warning && !warnings_are_errors)
 730         warnings++;
 731       else
 732         gfc_increment_error_count();
 733     }
 734
 735   return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
 736 }
 737
 738
 739 /* Immediate warning (i.e. do not buffer the warning).  */
 740
 741 void
 742 gfc_warning_now (const char *nocmsgid, ...)
 743 {
 744   va_list argp;
 745   int i;
 746
 747   if (inhibit_warnings)
 748     return;
 749
 750   i = buffer_flag;
 751   buffer_flag = 0;
 752   warnings++;
 753   if (warnings_are_errors)
 754     gfc_increment_error_count();
 755
 756   va_start (argp, nocmsgid);
 757   error_print (_("Warning:"), _(nocmsgid), argp);
 758   va_end (argp);
 759
 760   error_char ('\0');
 761   buffer_flag = i;
 762 }
 763
 764
 765 /* Clear the warning flag.  */
 766
 767 void
 768 gfc_clear_warning (void)
 769 {
 770   warning_buffer.flag = 0;
 771 }
 772
 773
 774 /* Check to see if any warnings have been saved.
 775    If so, print the warning.  */
 776
 777 void
 778 gfc_warning_check (void)
 779 {
 780   if (warning_buffer.flag)
 781     {
 782       warnings++;
 783       if (warning_buffer.message != NULL)
 784         fputs (warning_buffer.message, stderr);
 785       warning_buffer.flag = 0;
 786     }
 787 }
 788
 789
 790 /* Issue an error.  */
 791
 792 void
 793 gfc_error (const char *nocmsgid, ...)
 794 {
 795   va_list argp;
 796
 797   if (gfc_suppress_error)
 798     return;
 799
 800   error_buffer.flag = 1;
 801   error_buffer.index = 0;
 802   cur_error_buffer = &error_buffer;
 803
 804   va_start (argp, nocmsgid);
 805   error_print (_("Error:"), _(nocmsgid), argp);
 806   va_end (argp);
 807
 808   error_char ('\0');
 809
 810   if (buffer_flag == 0)
 811     gfc_increment_error_count();
 812 }
 813
 814
 815 /* Immediate error.  */
 816
 817 void
 818 gfc_error_now (const char *nocmsgid, ...)
 819 {
 820   va_list argp;
 821   int i;
 822
 823   error_buffer.flag = 1;
 824   error_buffer.index = 0;
 825   cur_error_buffer = &error_buffer;
 826
 827   i = buffer_flag;
 828   buffer_flag = 0;
 829
 830   va_start (argp, nocmsgid);
 831   error_print (_("Error:"), _(nocmsgid), argp);
 832   va_end (argp);
 833
 834   error_char ('\0');
 835
 836   gfc_increment_error_count();
 837
 838   buffer_flag = i;
 839
 840   if (flag_fatal_errors)
 841     exit (1);
 842 }
 843
 844
 845 /* Fatal error, never returns.  */
 846
 847 void
 848 gfc_fatal_error (const char *nocmsgid, ...)
 849 {
 850   va_list argp;
 851
 852   buffer_flag = 0;
 853
 854   va_start (argp, nocmsgid);
 855   error_print (_("Fatal Error:"), _(nocmsgid), argp);
 856   va_end (argp);
 857
 858   exit (3);
 859 }
 860
 861
 862 /* This shouldn't happen... but sometimes does.  */
 863
 864 void
 865 gfc_internal_error (const char *format, ...)
 866 {
 867   va_list argp;
 868
 869   buffer_flag = 0;
 870
 871   va_start (argp, format);
 872
 873   show_loci (&gfc_current_locus, NULL);
 874   error_printf ("Internal Error at (1):");
 875
 876   error_print ("", format, argp);
 877   va_end (argp);
 878
 879   exit (ICE_EXIT_CODE);
 880 }
 881
 882
 883 /* Clear the error flag when we start to compile a source line.  */
 884
 885 void
 886 gfc_clear_error (void)
 887 {
 888   error_buffer.flag = 0;
 889 }
 890
 891
 892 /* Tests the state of error_flag.  */
 893
 894 int
 895 gfc_error_flag_test (void)
 896 {
 897   return error_buffer.flag;
 898 }
 899
 900
 901 /* Check to see if any errors have been saved.
 902    If so, print the error.  Returns the state of error_flag.  */
 903
 904 int
 905 gfc_error_check (void)
 906 {
 907   int rc;
 908
 909   rc = error_buffer.flag;
 910
 911   if (error_buffer.flag)
 912     {
 913       if (error_buffer.message != NULL)
 914         fputs (error_buffer.message, stderr);
 915       error_buffer.flag = 0;
 916
 917       gfc_increment_error_count();
 918
 919       if (flag_fatal_errors)
 920         exit (1);
 921     }
 922
 923   return rc;
 924 }
 925
 926
 927 /* Save the existing error state.  */
 928
 929 void
 930 gfc_push_error (gfc_error_buf *err)
 931 {
 932   err->flag = error_buffer.flag;
 933   if (error_buffer.flag)
 934     err->message = xstrdup (error_buffer.message);
 935
 936   error_buffer.flag = 0;
 937 }
 938
 939
 940 /* Restore a previous pushed error state.  */
 941
 942 void
 943 gfc_pop_error (gfc_error_buf *err)
 944 {
 945   error_buffer.flag = err->flag;
 946   if (error_buffer.flag)
 947     {
 948       size_t len = strlen (err->message) + 1;
 949       gcc_assert (len <= error_buffer.allocated);
 950       memcpy (error_buffer.message, err->message, len);
 951       gfc_free (err->message);
 952     }
 953 }
 954
 955
 956 /* Free a pushed error state, but keep the current error state.  */
 957
 958 void
 959 gfc_free_error (gfc_error_buf *err)
 960 {
 961   if (err->flag)
 962     gfc_free (err->message);
 963 }
 964
 965
 966 /* Report the number of warnings and errors that occurred to the caller.  */
 967
 968 void
 969 gfc_get_errors (int *w, int *e)
 970 {
 971   if (w != NULL)
 972     *w = warnings;
 973   if (e != NULL)
 974     *e = errors;
 975 }