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