gcc/fortran/error.c

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