OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [fortran/] [error.c] - Blame information for rev 764

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.