/* Handle errors.
|
/* Handle errors.
|
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
2010
|
2010
|
Free Software Foundation, Inc.
|
Free Software Foundation, Inc.
|
Contributed by Andy Vaught & Niels Kristian Bech Jensen
|
Contributed by Andy Vaught & Niels Kristian Bech Jensen
|
|
|
This file is part of GCC.
|
This file is part of GCC.
|
|
|
GCC is free software; you can redistribute it and/or modify it under
|
GCC is free software; you can redistribute it and/or modify it under
|
the terms of the GNU General Public License as published by the Free
|
the terms of the GNU General Public License as published by the Free
|
Software Foundation; either version 3, or (at your option) any later
|
Software Foundation; either version 3, or (at your option) any later
|
version.
|
version.
|
|
|
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
for more details.
|
for more details.
|
|
|
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
along with GCC; see the file COPYING3. If not see
|
along with GCC; see the file COPYING3. If not see
|
<http://www.gnu.org/licenses/>. */
|
<http://www.gnu.org/licenses/>. */
|
|
|
/* Handle the inevitable errors. A major catch here is that things
|
/* Handle the inevitable errors. A major catch here is that things
|
flagged as errors in one match subroutine can conceivably be legal
|
flagged as errors in one match subroutine can conceivably be legal
|
elsewhere. This means that error messages are recorded and saved
|
elsewhere. This means that error messages are recorded and saved
|
for possible use later. If a line does not match a legal
|
for possible use later. If a line does not match a legal
|
construction, then the saved error message is reported. */
|
construction, then the saved error message is reported. */
|
|
|
#include "config.h"
|
#include "config.h"
|
#include "system.h"
|
#include "system.h"
|
#include "flags.h"
|
#include "flags.h"
|
#include "gfortran.h"
|
#include "gfortran.h"
|
|
|
static int suppress_errors = 0;
|
static int suppress_errors = 0;
|
|
|
static int warnings_not_errors = 0;
|
static int warnings_not_errors = 0;
|
|
|
static int terminal_width, buffer_flag, errors, warnings;
|
static int terminal_width, buffer_flag, errors, warnings;
|
|
|
static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
|
static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
|
|
|
|
|
/* Go one level deeper suppressing errors. */
|
/* Go one level deeper suppressing errors. */
|
|
|
void
|
void
|
gfc_push_suppress_errors (void)
|
gfc_push_suppress_errors (void)
|
{
|
{
|
gcc_assert (suppress_errors >= 0);
|
gcc_assert (suppress_errors >= 0);
|
++suppress_errors;
|
++suppress_errors;
|
}
|
}
|
|
|
|
|
/* Leave one level of error suppressing. */
|
/* Leave one level of error suppressing. */
|
|
|
void
|
void
|
gfc_pop_suppress_errors (void)
|
gfc_pop_suppress_errors (void)
|
{
|
{
|
gcc_assert (suppress_errors > 0);
|
gcc_assert (suppress_errors > 0);
|
--suppress_errors;
|
--suppress_errors;
|
}
|
}
|
|
|
|
|
/* Per-file error initialization. */
|
/* Per-file error initialization. */
|
|
|
void
|
void
|
gfc_error_init_1 (void)
|
gfc_error_init_1 (void)
|
{
|
{
|
terminal_width = gfc_terminal_width ();
|
terminal_width = gfc_terminal_width ();
|
errors = 0;
|
errors = 0;
|
warnings = 0;
|
warnings = 0;
|
buffer_flag = 0;
|
buffer_flag = 0;
|
}
|
}
|
|
|
|
|
/* Set the flag for buffering errors or not. */
|
/* Set the flag for buffering errors or not. */
|
|
|
void
|
void
|
gfc_buffer_error (int flag)
|
gfc_buffer_error (int flag)
|
{
|
{
|
buffer_flag = flag;
|
buffer_flag = flag;
|
}
|
}
|
|
|
|
|
/* Add a single character to the error buffer or output depending on
|
/* Add a single character to the error buffer or output depending on
|
buffer_flag. */
|
buffer_flag. */
|
|
|
static void
|
static void
|
error_char (char c)
|
error_char (char c)
|
{
|
{
|
if (buffer_flag)
|
if (buffer_flag)
|
{
|
{
|
if (cur_error_buffer->index >= cur_error_buffer->allocated)
|
if (cur_error_buffer->index >= cur_error_buffer->allocated)
|
{
|
{
|
cur_error_buffer->allocated = cur_error_buffer->allocated
|
cur_error_buffer->allocated = cur_error_buffer->allocated
|
? cur_error_buffer->allocated * 2 : 1000;
|
? cur_error_buffer->allocated * 2 : 1000;
|
cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message,
|
cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message,
|
cur_error_buffer->allocated);
|
cur_error_buffer->allocated);
|
}
|
}
|
cur_error_buffer->message[cur_error_buffer->index++] = c;
|
cur_error_buffer->message[cur_error_buffer->index++] = c;
|
}
|
}
|
else
|
else
|
{
|
{
|
if (c != 0)
|
if (c != 0)
|
{
|
{
|
/* We build up complete lines before handing things
|
/* We build up complete lines before handing things
|
over to the library in order to speed up error printing. */
|
over to the library in order to speed up error printing. */
|
static char *line;
|
static char *line;
|
static size_t allocated = 0, index = 0;
|
static size_t allocated = 0, index = 0;
|
|
|
if (index + 1 >= allocated)
|
if (index + 1 >= allocated)
|
{
|
{
|
allocated = allocated ? allocated * 2 : 1000;
|
allocated = allocated ? allocated * 2 : 1000;
|
line = XRESIZEVEC (char, line, allocated);
|
line = XRESIZEVEC (char, line, allocated);
|
}
|
}
|
line[index++] = c;
|
line[index++] = c;
|
if (c == '\n')
|
if (c == '\n')
|
{
|
{
|
line[index] = '\0';
|
line[index] = '\0';
|
fputs (line, stderr);
|
fputs (line, stderr);
|
index = 0;
|
index = 0;
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
|
|
/* Copy a string to wherever it needs to go. */
|
/* Copy a string to wherever it needs to go. */
|
|
|
static void
|
static void
|
error_string (const char *p)
|
error_string (const char *p)
|
{
|
{
|
while (*p)
|
while (*p)
|
error_char (*p++);
|
error_char (*p++);
|
}
|
}
|
|
|
|
|
/* Print a formatted integer to the error buffer or output. */
|
/* Print a formatted integer to the error buffer or output. */
|
|
|
#define IBUF_LEN 60
|
#define IBUF_LEN 60
|
|
|
static void
|
static void
|
error_uinteger (unsigned long int i)
|
error_uinteger (unsigned long int i)
|
{
|
{
|
char *p, int_buf[IBUF_LEN];
|
char *p, int_buf[IBUF_LEN];
|
|
|
p = int_buf + IBUF_LEN - 1;
|
p = int_buf + IBUF_LEN - 1;
|
*p-- = '\0';
|
*p-- = '\0';
|
|
|
if (i == 0)
|
if (i == 0)
|
*p-- = '0';
|
*p-- = '0';
|
|
|
while (i > 0)
|
while (i > 0)
|
{
|
{
|
*p-- = i % 10 + '0';
|
*p-- = i % 10 + '0';
|
i = i / 10;
|
i = i / 10;
|
}
|
}
|
|
|
error_string (p + 1);
|
error_string (p + 1);
|
}
|
}
|
|
|
static void
|
static void
|
error_integer (long int i)
|
error_integer (long int i)
|
{
|
{
|
unsigned long int u;
|
unsigned long int u;
|
|
|
if (i < 0)
|
if (i < 0)
|
{
|
{
|
u = (unsigned long int) -i;
|
u = (unsigned long int) -i;
|
error_char ('-');
|
error_char ('-');
|
}
|
}
|
else
|
else
|
u = i;
|
u = i;
|
|
|
error_uinteger (u);
|
error_uinteger (u);
|
}
|
}
|
|
|
|
|
static void
|
static void
|
print_wide_char_into_buffer (gfc_char_t c, char *buf)
|
print_wide_char_into_buffer (gfc_char_t c, char *buf)
|
{
|
{
|
static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
|
static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
|
'7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
|
'7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
|
|
|
if (gfc_wide_is_printable (c))
|
if (gfc_wide_is_printable (c))
|
{
|
{
|
buf[1] = '\0';
|
buf[1] = '\0';
|
buf[0] = (unsigned char) c;
|
buf[0] = (unsigned char) c;
|
}
|
}
|
else if (c < ((gfc_char_t) 1 << 8))
|
else if (c < ((gfc_char_t) 1 << 8))
|
{
|
{
|
buf[4] = '\0';
|
buf[4] = '\0';
|
buf[3] = xdigit[c & 0x0F];
|
buf[3] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[2] = xdigit[c & 0x0F];
|
buf[2] = xdigit[c & 0x0F];
|
|
|
buf[1] = 'x';
|
buf[1] = 'x';
|
buf[0] = '\\';
|
buf[0] = '\\';
|
}
|
}
|
else if (c < ((gfc_char_t) 1 << 16))
|
else if (c < ((gfc_char_t) 1 << 16))
|
{
|
{
|
buf[6] = '\0';
|
buf[6] = '\0';
|
buf[5] = xdigit[c & 0x0F];
|
buf[5] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[4] = xdigit[c & 0x0F];
|
buf[4] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[3] = xdigit[c & 0x0F];
|
buf[3] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[2] = xdigit[c & 0x0F];
|
buf[2] = xdigit[c & 0x0F];
|
|
|
buf[1] = 'u';
|
buf[1] = 'u';
|
buf[0] = '\\';
|
buf[0] = '\\';
|
}
|
}
|
else
|
else
|
{
|
{
|
buf[10] = '\0';
|
buf[10] = '\0';
|
buf[9] = xdigit[c & 0x0F];
|
buf[9] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[8] = xdigit[c & 0x0F];
|
buf[8] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[7] = xdigit[c & 0x0F];
|
buf[7] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[6] = xdigit[c & 0x0F];
|
buf[6] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[5] = xdigit[c & 0x0F];
|
buf[5] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[4] = xdigit[c & 0x0F];
|
buf[4] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[3] = xdigit[c & 0x0F];
|
buf[3] = xdigit[c & 0x0F];
|
c = c >> 4;
|
c = c >> 4;
|
buf[2] = xdigit[c & 0x0F];
|
buf[2] = xdigit[c & 0x0F];
|
|
|
buf[1] = 'U';
|
buf[1] = 'U';
|
buf[0] = '\\';
|
buf[0] = '\\';
|
}
|
}
|
}
|
}
|
|
|
static char wide_char_print_buffer[11];
|
static char wide_char_print_buffer[11];
|
|
|
const char *
|
const char *
|
gfc_print_wide_char (gfc_char_t c)
|
gfc_print_wide_char (gfc_char_t c)
|
{
|
{
|
print_wide_char_into_buffer (c, wide_char_print_buffer);
|
print_wide_char_into_buffer (c, wide_char_print_buffer);
|
return wide_char_print_buffer;
|
return wide_char_print_buffer;
|
}
|
}
|
|
|
|
|
/* Show the file, where it was included, and the source line, give a
|
/* Show the file, where it was included, and the source line, give a
|
locus. Calls error_printf() recursively, but the recursion is at
|
locus. Calls error_printf() recursively, but the recursion is at
|
most one level deep. */
|
most one level deep. */
|
|
|
static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
|
static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
|
|
|
static void
|
static void
|
show_locus (locus *loc, int c1, int c2)
|
show_locus (locus *loc, int c1, int c2)
|
{
|
{
|
gfc_linebuf *lb;
|
gfc_linebuf *lb;
|
gfc_file *f;
|
gfc_file *f;
|
gfc_char_t c, *p;
|
gfc_char_t c, *p;
|
int i, offset, cmax;
|
int i, offset, cmax;
|
|
|
/* TODO: Either limit the total length and number of included files
|
/* TODO: Either limit the total length and number of included files
|
displayed or add buffering of arbitrary number of characters in
|
displayed or add buffering of arbitrary number of characters in
|
error messages. */
|
error messages. */
|
|
|
/* Write out the error header line, giving the source file and error
|
/* Write out the error header line, giving the source file and error
|
location (in GNU standard "[file]:[line].[column]:" format),
|
location (in GNU standard "[file]:[line].[column]:" format),
|
followed by an "included by" stack and a blank line. This header
|
followed by an "included by" stack and a blank line. This header
|
format is matched by a testsuite parser defined in
|
format is matched by a testsuite parser defined in
|
lib/gfortran-dg.exp. */
|
lib/gfortran-dg.exp. */
|
|
|
lb = loc->lb;
|
lb = loc->lb;
|
f = lb->file;
|
f = lb->file;
|
|
|
error_string (f->filename);
|
error_string (f->filename);
|
error_char (':');
|
error_char (':');
|
|
|
error_integer (LOCATION_LINE (lb->location));
|
error_integer (LOCATION_LINE (lb->location));
|
|
|
if ((c1 > 0) || (c2 > 0))
|
if ((c1 > 0) || (c2 > 0))
|
error_char ('.');
|
error_char ('.');
|
|
|
if (c1 > 0)
|
if (c1 > 0)
|
error_integer (c1);
|
error_integer (c1);
|
|
|
if ((c1 > 0) && (c2 > 0))
|
if ((c1 > 0) && (c2 > 0))
|
error_char ('-');
|
error_char ('-');
|
|
|
if (c2 > 0)
|
if (c2 > 0)
|
error_integer (c2);
|
error_integer (c2);
|
|
|
error_char (':');
|
error_char (':');
|
error_char ('\n');
|
error_char ('\n');
|
|
|
for (;;)
|
for (;;)
|
{
|
{
|
i = f->inclusion_line;
|
i = f->inclusion_line;
|
|
|
f = f->up;
|
f = f->up;
|
if (f == NULL) break;
|
if (f == NULL) break;
|
|
|
error_printf (" Included at %s:%d:", f->filename, i);
|
error_printf (" Included at %s:%d:", f->filename, i);
|
}
|
}
|
|
|
error_char ('\n');
|
error_char ('\n');
|
|
|
/* Calculate an appropriate horizontal offset of the source line in
|
/* Calculate an appropriate horizontal offset of the source line in
|
order to get the error locus within the visible portion of the
|
order to get the error locus within the visible portion of the
|
line. Note that if the margin of 5 here is changed, the
|
line. Note that if the margin of 5 here is changed, the
|
corresponding margin of 10 in show_loci should be changed. */
|
corresponding margin of 10 in show_loci should be changed. */
|
|
|
offset = 0;
|
offset = 0;
|
|
|
/* If the two loci would appear in the same column, we shift
|
/* If the two loci would appear in the same column, we shift
|
'2' one column to the right, so as to print '12' rather than
|
'2' one column to the right, so as to print '12' rather than
|
just '1'. We do this here so it will be accounted for in the
|
just '1'. We do this here so it will be accounted for in the
|
margin calculations. */
|
margin calculations. */
|
|
|
if (c1 == c2)
|
if (c1 == c2)
|
c2 += 1;
|
c2 += 1;
|
|
|
cmax = (c1 < c2) ? c2 : c1;
|
cmax = (c1 < c2) ? c2 : c1;
|
if (cmax > terminal_width - 5)
|
if (cmax > terminal_width - 5)
|
offset = cmax - terminal_width + 5;
|
offset = cmax - terminal_width + 5;
|
|
|
/* Show the line itself, taking care not to print more than what can
|
/* Show the line itself, taking care not to print more than what can
|
show up on the terminal. Tabs are converted to spaces, and
|
show up on the terminal. Tabs are converted to spaces, and
|
nonprintable characters are converted to a "\xNN" sequence. */
|
nonprintable characters are converted to a "\xNN" sequence. */
|
|
|
/* TODO: Although setting i to the terminal width is clever, it fails
|
/* TODO: Although setting i to the terminal width is clever, it fails
|
to work correctly when nonprintable characters exist. A better
|
to work correctly when nonprintable characters exist. A better
|
solution should be found. */
|
solution should be found. */
|
|
|
p = &(lb->line[offset]);
|
p = &(lb->line[offset]);
|
i = gfc_wide_strlen (p);
|
i = gfc_wide_strlen (p);
|
if (i > terminal_width)
|
if (i > terminal_width)
|
i = terminal_width - 1;
|
i = terminal_width - 1;
|
|
|
for (; i > 0; i--)
|
for (; i > 0; i--)
|
{
|
{
|
static char buffer[11];
|
static char buffer[11];
|
|
|
c = *p++;
|
c = *p++;
|
if (c == '\t')
|
if (c == '\t')
|
c = ' ';
|
c = ' ';
|
|
|
print_wide_char_into_buffer (c, buffer);
|
print_wide_char_into_buffer (c, buffer);
|
error_string (buffer);
|
error_string (buffer);
|
}
|
}
|
|
|
error_char ('\n');
|
error_char ('\n');
|
|
|
/* Show the '1' and/or '2' corresponding to the column of the error
|
/* Show the '1' and/or '2' corresponding to the column of the error
|
locus. Note that a value of -1 for c1 or c2 will simply cause
|
locus. Note that a value of -1 for c1 or c2 will simply cause
|
the relevant number not to be printed. */
|
the relevant number not to be printed. */
|
|
|
c1 -= offset;
|
c1 -= offset;
|
c2 -= offset;
|
c2 -= offset;
|
|
|
for (i = 0; i <= cmax; i++)
|
for (i = 0; i <= cmax; i++)
|
{
|
{
|
if (i == c1)
|
if (i == c1)
|
error_char ('1');
|
error_char ('1');
|
else if (i == c2)
|
else if (i == c2)
|
error_char ('2');
|
error_char ('2');
|
else
|
else
|
error_char (' ');
|
error_char (' ');
|
}
|
}
|
|
|
error_char ('\n');
|
error_char ('\n');
|
|
|
}
|
}
|
|
|
|
|
/* As part of printing an error, we show the source lines that caused
|
/* As part of printing an error, we show the source lines that caused
|
the problem. We show at least one, and possibly two loci; the two
|
the problem. We show at least one, and possibly two loci; the two
|
loci may or may not be on the same source line. */
|
loci may or may not be on the same source line. */
|
|
|
static void
|
static void
|
show_loci (locus *l1, locus *l2)
|
show_loci (locus *l1, locus *l2)
|
{
|
{
|
int m, c1, c2;
|
int m, c1, c2;
|
|
|
if (l1 == NULL || l1->lb == NULL)
|
if (l1 == NULL || l1->lb == NULL)
|
{
|
{
|
error_printf ("<During initialization>\n");
|
error_printf ("<During initialization>\n");
|
return;
|
return;
|
}
|
}
|
|
|
/* While calculating parameters for printing the loci, we consider possible
|
/* While calculating parameters for printing the loci, we consider possible
|
reasons for printing one per line. If appropriate, print the loci
|
reasons for printing one per line. If appropriate, print the loci
|
individually; otherwise we print them both on the same line. */
|
individually; otherwise we print them both on the same line. */
|
|
|
c1 = l1->nextc - l1->lb->line;
|
c1 = l1->nextc - l1->lb->line;
|
if (l2 == NULL)
|
if (l2 == NULL)
|
{
|
{
|
show_locus (l1, c1, -1);
|
show_locus (l1, c1, -1);
|
return;
|
return;
|
}
|
}
|
|
|
c2 = l2->nextc - l2->lb->line;
|
c2 = l2->nextc - l2->lb->line;
|
|
|
if (c1 < c2)
|
if (c1 < c2)
|
m = c2 - c1;
|
m = c2 - c1;
|
else
|
else
|
m = c1 - c2;
|
m = c1 - c2;
|
|
|
/* Note that the margin value of 10 here needs to be less than the
|
/* Note that the margin value of 10 here needs to be less than the
|
margin of 5 used in the calculation of offset in show_locus. */
|
margin of 5 used in the calculation of offset in show_locus. */
|
|
|
if (l1->lb != l2->lb || m > terminal_width - 10)
|
if (l1->lb != l2->lb || m > terminal_width - 10)
|
{
|
{
|
show_locus (l1, c1, -1);
|
show_locus (l1, c1, -1);
|
show_locus (l2, -1, c2);
|
show_locus (l2, -1, c2);
|
return;
|
return;
|
}
|
}
|
|
|
show_locus (l1, c1, c2);
|
show_locus (l1, c1, c2);
|
|
|
return;
|
return;
|
}
|
}
|
|
|
|
|
/* Workhorse for the error printing subroutines. This subroutine is
|
/* Workhorse for the error printing subroutines. This subroutine is
|
inspired by g77's error handling and is similar to printf() with
|
inspired by g77's error handling and is similar to printf() with
|
the following %-codes:
|
the following %-codes:
|
|
|
%c Character, %d or %i Integer, %s String, %% Percent
|
%c Character, %d or %i Integer, %s String, %% Percent
|
%L Takes locus argument
|
%L Takes locus argument
|
%C Current locus (no argument)
|
%C Current locus (no argument)
|
|
|
If a locus pointer is given, the actual source line is printed out
|
If a locus pointer is given, the actual source line is printed out
|
and the column is indicated. Since we want the error message at
|
and the column is indicated. Since we want the error message at
|
the bottom of any source file information, we must scan the
|
the bottom of any source file information, we must scan the
|
argument list twice -- once to determine whether the loci are
|
argument list twice -- once to determine whether the loci are
|
present and record this for printing, and once to print the error
|
present and record this for printing, and once to print the error
|
message after and loci have been printed. A maximum of two locus
|
message after and loci have been printed. A maximum of two locus
|
arguments are permitted.
|
arguments are permitted.
|
|
|
This function is also called (recursively) by show_locus in the
|
This function is also called (recursively) by show_locus in the
|
case of included files; however, as show_locus does not resupply
|
case of included files; however, as show_locus does not resupply
|
any loci, the recursion is at most one level deep. */
|
any loci, the recursion is at most one level deep. */
|
|
|
#define MAX_ARGS 10
|
#define MAX_ARGS 10
|
|
|
static void ATTRIBUTE_GCC_GFC(2,0)
|
static void ATTRIBUTE_GCC_GFC(2,0)
|
error_print (const char *type, const char *format0, va_list argp)
|
error_print (const char *type, const char *format0, va_list argp)
|
{
|
{
|
enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
|
enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
|
TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
|
TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
|
NOTYPE };
|
NOTYPE };
|
struct
|
struct
|
{
|
{
|
int type;
|
int type;
|
int pos;
|
int pos;
|
union
|
union
|
{
|
{
|
int intval;
|
int intval;
|
unsigned int uintval;
|
unsigned int uintval;
|
long int longintval;
|
long int longintval;
|
unsigned long int ulongintval;
|
unsigned long int ulongintval;
|
char charval;
|
char charval;
|
const char * stringval;
|
const char * stringval;
|
} u;
|
} u;
|
} arg[MAX_ARGS], spec[MAX_ARGS];
|
} arg[MAX_ARGS], spec[MAX_ARGS];
|
/* spec is the array of specifiers, in the same order as they
|
/* spec is the array of specifiers, in the same order as they
|
appear in the format string. arg is the array of arguments,
|
appear in the format string. arg is the array of arguments,
|
in the same order as they appear in the va_list. */
|
in the same order as they appear in the va_list. */
|
|
|
char c;
|
char c;
|
int i, n, have_l1, pos, maxpos;
|
int i, n, have_l1, pos, maxpos;
|
locus *l1, *l2, *loc;
|
locus *l1, *l2, *loc;
|
const char *format;
|
const char *format;
|
|
|
l1 = l2 = NULL;
|
l1 = l2 = NULL;
|
|
|
have_l1 = 0;
|
have_l1 = 0;
|
pos = -1;
|
pos = -1;
|
maxpos = -1;
|
maxpos = -1;
|
|
|
n = 0;
|
n = 0;
|
format = format0;
|
format = format0;
|
|
|
for (i = 0; i < MAX_ARGS; i++)
|
for (i = 0; i < MAX_ARGS; i++)
|
{
|
{
|
arg[i].type = NOTYPE;
|
arg[i].type = NOTYPE;
|
spec[i].pos = -1;
|
spec[i].pos = -1;
|
}
|
}
|
|
|
/* First parse the format string for position specifiers. */
|
/* First parse the format string for position specifiers. */
|
while (*format)
|
while (*format)
|
{
|
{
|
c = *format++;
|
c = *format++;
|
if (c != '%')
|
if (c != '%')
|
continue;
|
continue;
|
|
|
if (*format == '%')
|
if (*format == '%')
|
{
|
{
|
format++;
|
format++;
|
continue;
|
continue;
|
}
|
}
|
|
|
if (ISDIGIT (*format))
|
if (ISDIGIT (*format))
|
{
|
{
|
/* This is a position specifier. For example, the number
|
/* This is a position specifier. For example, the number
|
12 in the format string "%12$d", which specifies the third
|
12 in the format string "%12$d", which specifies the third
|
argument of the va_list, formatted in %d format.
|
argument of the va_list, formatted in %d format.
|
For details, see "man 3 printf". */
|
For details, see "man 3 printf". */
|
pos = atoi(format) - 1;
|
pos = atoi(format) - 1;
|
gcc_assert (pos >= 0);
|
gcc_assert (pos >= 0);
|
while (ISDIGIT(*format))
|
while (ISDIGIT(*format))
|
format++;
|
format++;
|
gcc_assert (*format++ == '$');
|
gcc_assert (*format++ == '$');
|
}
|
}
|
else
|
else
|
pos++;
|
pos++;
|
|
|
c = *format++;
|
c = *format++;
|
|
|
if (pos > maxpos)
|
if (pos > maxpos)
|
maxpos = pos;
|
maxpos = pos;
|
|
|
switch (c)
|
switch (c)
|
{
|
{
|
case 'C':
|
case 'C':
|
arg[pos].type = TYPE_CURRENTLOC;
|
arg[pos].type = TYPE_CURRENTLOC;
|
break;
|
break;
|
|
|
case 'L':
|
case 'L':
|
arg[pos].type = TYPE_LOCUS;
|
arg[pos].type = TYPE_LOCUS;
|
break;
|
break;
|
|
|
case 'd':
|
case 'd':
|
case 'i':
|
case 'i':
|
arg[pos].type = TYPE_INTEGER;
|
arg[pos].type = TYPE_INTEGER;
|
break;
|
break;
|
|
|
case 'u':
|
case 'u':
|
arg[pos].type = TYPE_UINTEGER;
|
arg[pos].type = TYPE_UINTEGER;
|
break;
|
break;
|
|
|
case 'l':
|
case 'l':
|
c = *format++;
|
c = *format++;
|
if (c == 'u')
|
if (c == 'u')
|
arg[pos].type = TYPE_ULONGINT;
|
arg[pos].type = TYPE_ULONGINT;
|
else if (c == 'i' || c == 'd')
|
else if (c == 'i' || c == 'd')
|
arg[pos].type = TYPE_LONGINT;
|
arg[pos].type = TYPE_LONGINT;
|
else
|
else
|
gcc_unreachable ();
|
gcc_unreachable ();
|
break;
|
break;
|
|
|
case 'c':
|
case 'c':
|
arg[pos].type = TYPE_CHAR;
|
arg[pos].type = TYPE_CHAR;
|
break;
|
break;
|
|
|
case 's':
|
case 's':
|
arg[pos].type = TYPE_STRING;
|
arg[pos].type = TYPE_STRING;
|
break;
|
break;
|
|
|
default:
|
default:
|
gcc_unreachable ();
|
gcc_unreachable ();
|
}
|
}
|
|
|
spec[n++].pos = pos;
|
spec[n++].pos = pos;
|
}
|
}
|
|
|
/* Then convert the values for each %-style argument. */
|
/* Then convert the values for each %-style argument. */
|
for (pos = 0; pos <= maxpos; pos++)
|
for (pos = 0; pos <= maxpos; pos++)
|
{
|
{
|
gcc_assert (arg[pos].type != NOTYPE);
|
gcc_assert (arg[pos].type != NOTYPE);
|
switch (arg[pos].type)
|
switch (arg[pos].type)
|
{
|
{
|
case TYPE_CURRENTLOC:
|
case TYPE_CURRENTLOC:
|
loc = &gfc_current_locus;
|
loc = &gfc_current_locus;
|
/* Fall through. */
|
/* Fall through. */
|
|
|
case TYPE_LOCUS:
|
case TYPE_LOCUS:
|
if (arg[pos].type == TYPE_LOCUS)
|
if (arg[pos].type == TYPE_LOCUS)
|
loc = va_arg (argp, locus *);
|
loc = va_arg (argp, locus *);
|
|
|
if (have_l1)
|
if (have_l1)
|
{
|
{
|
l2 = loc;
|
l2 = loc;
|
arg[pos].u.stringval = "(2)";
|
arg[pos].u.stringval = "(2)";
|
}
|
}
|
else
|
else
|
{
|
{
|
l1 = loc;
|
l1 = loc;
|
have_l1 = 1;
|
have_l1 = 1;
|
arg[pos].u.stringval = "(1)";
|
arg[pos].u.stringval = "(1)";
|
}
|
}
|
break;
|
break;
|
|
|
case TYPE_INTEGER:
|
case TYPE_INTEGER:
|
arg[pos].u.intval = va_arg (argp, int);
|
arg[pos].u.intval = va_arg (argp, int);
|
break;
|
break;
|
|
|
case TYPE_UINTEGER:
|
case TYPE_UINTEGER:
|
arg[pos].u.uintval = va_arg (argp, unsigned int);
|
arg[pos].u.uintval = va_arg (argp, unsigned int);
|
break;
|
break;
|
|
|
case TYPE_LONGINT:
|
case TYPE_LONGINT:
|
arg[pos].u.longintval = va_arg (argp, long int);
|
arg[pos].u.longintval = va_arg (argp, long int);
|
break;
|
break;
|
|
|
case TYPE_ULONGINT:
|
case TYPE_ULONGINT:
|
arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
|
arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
|
break;
|
break;
|
|
|
case TYPE_CHAR:
|
case TYPE_CHAR:
|
arg[pos].u.charval = (char) va_arg (argp, int);
|
arg[pos].u.charval = (char) va_arg (argp, int);
|
break;
|
break;
|
|
|
case TYPE_STRING:
|
case TYPE_STRING:
|
arg[pos].u.stringval = (const char *) va_arg (argp, char *);
|
arg[pos].u.stringval = (const char *) va_arg (argp, char *);
|
break;
|
break;
|
|
|
default:
|
default:
|
gcc_unreachable ();
|
gcc_unreachable ();
|
}
|
}
|
}
|
}
|
|
|
for (n = 0; spec[n].pos >= 0; n++)
|
for (n = 0; spec[n].pos >= 0; n++)
|
spec[n].u = arg[spec[n].pos].u;
|
spec[n].u = arg[spec[n].pos].u;
|
|
|
/* Show the current loci if we have to. */
|
/* Show the current loci if we have to. */
|
if (have_l1)
|
if (have_l1)
|
show_loci (l1, l2);
|
show_loci (l1, l2);
|
|
|
if (*type)
|
if (*type)
|
{
|
{
|
error_string (type);
|
error_string (type);
|
error_char (' ');
|
error_char (' ');
|
}
|
}
|
|
|
have_l1 = 0;
|
have_l1 = 0;
|
format = format0;
|
format = format0;
|
n = 0;
|
n = 0;
|
|
|
for (; *format; format++)
|
for (; *format; format++)
|
{
|
{
|
if (*format != '%')
|
if (*format != '%')
|
{
|
{
|
error_char (*format);
|
error_char (*format);
|
continue;
|
continue;
|
}
|
}
|
|
|
format++;
|
format++;
|
if (ISDIGIT (*format))
|
if (ISDIGIT (*format))
|
{
|
{
|
/* This is a position specifier. See comment above. */
|
/* This is a position specifier. See comment above. */
|
while (ISDIGIT (*format))
|
while (ISDIGIT (*format))
|
format++;
|
format++;
|
|
|
/* Skip over the dollar sign. */
|
/* Skip over the dollar sign. */
|
format++;
|
format++;
|
}
|
}
|
|
|
switch (*format)
|
switch (*format)
|
{
|
{
|
case '%':
|
case '%':
|
error_char ('%');
|
error_char ('%');
|
break;
|
break;
|
|
|
case 'c':
|
case 'c':
|
error_char (spec[n++].u.charval);
|
error_char (spec[n++].u.charval);
|
break;
|
break;
|
|
|
case 's':
|
case 's':
|
case 'C': /* Current locus */
|
case 'C': /* Current locus */
|
case 'L': /* Specified locus */
|
case 'L': /* Specified locus */
|
error_string (spec[n++].u.stringval);
|
error_string (spec[n++].u.stringval);
|
break;
|
break;
|
|
|
case 'd':
|
case 'd':
|
case 'i':
|
case 'i':
|
error_integer (spec[n++].u.intval);
|
error_integer (spec[n++].u.intval);
|
break;
|
break;
|
|
|
case 'u':
|
case 'u':
|
error_uinteger (spec[n++].u.uintval);
|
error_uinteger (spec[n++].u.uintval);
|
break;
|
break;
|
|
|
case 'l':
|
case 'l':
|
format++;
|
format++;
|
if (*format == 'u')
|
if (*format == 'u')
|
error_uinteger (spec[n++].u.ulongintval);
|
error_uinteger (spec[n++].u.ulongintval);
|
else
|
else
|
error_integer (spec[n++].u.longintval);
|
error_integer (spec[n++].u.longintval);
|
break;
|
break;
|
|
|
}
|
}
|
}
|
}
|
|
|
error_char ('\n');
|
error_char ('\n');
|
}
|
}
|
|
|
|
|
/* Wrapper for error_print(). */
|
/* Wrapper for error_print(). */
|
|
|
static void
|
static void
|
error_printf (const char *gmsgid, ...)
|
error_printf (const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print ("", _(gmsgid), argp);
|
error_print ("", _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
}
|
}
|
|
|
|
|
/* Increment the number of errors, and check whether too many have
|
/* Increment the number of errors, and check whether too many have
|
been printed. */
|
been printed. */
|
|
|
static void
|
static void
|
gfc_increment_error_count (void)
|
gfc_increment_error_count (void)
|
{
|
{
|
errors++;
|
errors++;
|
if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
|
if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
|
gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
|
gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
|
}
|
}
|
|
|
|
|
/* Issue a warning. */
|
/* Issue a warning. */
|
|
|
void
|
void
|
gfc_warning (const char *gmsgid, ...)
|
gfc_warning (const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
|
|
if (inhibit_warnings)
|
if (inhibit_warnings)
|
return;
|
return;
|
|
|
warning_buffer.flag = 1;
|
warning_buffer.flag = 1;
|
warning_buffer.index = 0;
|
warning_buffer.index = 0;
|
cur_error_buffer = &warning_buffer;
|
cur_error_buffer = &warning_buffer;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
error_char ('\0');
|
error_char ('\0');
|
|
|
if (buffer_flag == 0)
|
if (buffer_flag == 0)
|
{
|
{
|
warnings++;
|
warnings++;
|
if (warnings_are_errors)
|
if (warnings_are_errors)
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
}
|
}
|
}
|
}
|
|
|
|
|
/* Whether, for a feature included in a given standard set (GFC_STD_*),
|
/* Whether, for a feature included in a given standard set (GFC_STD_*),
|
we should issue an error or a warning, or be quiet. */
|
we should issue an error or a warning, or be quiet. */
|
|
|
notification
|
notification
|
gfc_notification_std (int std)
|
gfc_notification_std (int std)
|
{
|
{
|
bool warning;
|
bool warning;
|
|
|
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
|
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
|
if ((gfc_option.allow_std & std) != 0 && !warning)
|
if ((gfc_option.allow_std & std) != 0 && !warning)
|
return SILENT;
|
return SILENT;
|
|
|
return warning ? WARNING : ERROR;
|
return warning ? WARNING : ERROR;
|
}
|
}
|
|
|
|
|
/* Possibly issue a warning/error about use of a nonstandard (or deleted)
|
/* Possibly issue a warning/error about use of a nonstandard (or deleted)
|
feature. An error/warning will be issued if the currently selected
|
feature. An error/warning will be issued if the currently selected
|
standard does not contain the requested bits. Return FAILURE if
|
standard does not contain the requested bits. Return FAILURE if
|
an error is generated. */
|
an error is generated. */
|
|
|
gfc_try
|
gfc_try
|
gfc_notify_std (int std, const char *gmsgid, ...)
|
gfc_notify_std (int std, const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
bool warning;
|
bool warning;
|
|
|
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
|
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
|
if ((gfc_option.allow_std & std) != 0 && !warning)
|
if ((gfc_option.allow_std & std) != 0 && !warning)
|
return SUCCESS;
|
return SUCCESS;
|
|
|
if (suppress_errors)
|
if (suppress_errors)
|
return warning ? SUCCESS : FAILURE;
|
return warning ? SUCCESS : FAILURE;
|
|
|
cur_error_buffer = warning ? &warning_buffer : &error_buffer;
|
cur_error_buffer = warning ? &warning_buffer : &error_buffer;
|
cur_error_buffer->flag = 1;
|
cur_error_buffer->flag = 1;
|
cur_error_buffer->index = 0;
|
cur_error_buffer->index = 0;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
if (warning)
|
if (warning)
|
error_print (_("Warning:"), _(gmsgid), argp);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
else
|
else
|
error_print (_("Error:"), _(gmsgid), argp);
|
error_print (_("Error:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
error_char ('\0');
|
error_char ('\0');
|
|
|
if (buffer_flag == 0)
|
if (buffer_flag == 0)
|
{
|
{
|
if (warning && !warnings_are_errors)
|
if (warning && !warnings_are_errors)
|
warnings++;
|
warnings++;
|
else
|
else
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
}
|
}
|
|
|
return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
|
return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
|
}
|
}
|
|
|
|
|
/* Immediate warning (i.e. do not buffer the warning). */
|
/* Immediate warning (i.e. do not buffer the warning). */
|
|
|
void
|
void
|
gfc_warning_now (const char *gmsgid, ...)
|
gfc_warning_now (const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
int i;
|
int i;
|
|
|
if (inhibit_warnings)
|
if (inhibit_warnings)
|
return;
|
return;
|
|
|
i = buffer_flag;
|
i = buffer_flag;
|
buffer_flag = 0;
|
buffer_flag = 0;
|
warnings++;
|
warnings++;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
error_char ('\0');
|
error_char ('\0');
|
|
|
if (warnings_are_errors)
|
if (warnings_are_errors)
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
|
|
buffer_flag = i;
|
buffer_flag = i;
|
}
|
}
|
|
|
|
|
/* Clear the warning flag. */
|
/* Clear the warning flag. */
|
|
|
void
|
void
|
gfc_clear_warning (void)
|
gfc_clear_warning (void)
|
{
|
{
|
warning_buffer.flag = 0;
|
warning_buffer.flag = 0;
|
}
|
}
|
|
|
|
|
/* Check to see if any warnings have been saved.
|
/* Check to see if any warnings have been saved.
|
If so, print the warning. */
|
If so, print the warning. */
|
|
|
void
|
void
|
gfc_warning_check (void)
|
gfc_warning_check (void)
|
{
|
{
|
if (warning_buffer.flag)
|
if (warning_buffer.flag)
|
{
|
{
|
warnings++;
|
warnings++;
|
if (warning_buffer.message != NULL)
|
if (warning_buffer.message != NULL)
|
fputs (warning_buffer.message, stderr);
|
fputs (warning_buffer.message, stderr);
|
warning_buffer.flag = 0;
|
warning_buffer.flag = 0;
|
}
|
}
|
}
|
}
|
|
|
|
|
/* Issue an error. */
|
/* Issue an error. */
|
|
|
void
|
void
|
gfc_error (const char *gmsgid, ...)
|
gfc_error (const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
|
|
if (warnings_not_errors)
|
if (warnings_not_errors)
|
goto warning;
|
goto warning;
|
|
|
if (suppress_errors)
|
if (suppress_errors)
|
return;
|
return;
|
|
|
error_buffer.flag = 1;
|
error_buffer.flag = 1;
|
error_buffer.index = 0;
|
error_buffer.index = 0;
|
cur_error_buffer = &error_buffer;
|
cur_error_buffer = &error_buffer;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print (_("Error:"), _(gmsgid), argp);
|
error_print (_("Error:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
error_char ('\0');
|
error_char ('\0');
|
|
|
if (buffer_flag == 0)
|
if (buffer_flag == 0)
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
|
|
return;
|
return;
|
|
|
warning:
|
warning:
|
|
|
if (inhibit_warnings)
|
if (inhibit_warnings)
|
return;
|
return;
|
|
|
warning_buffer.flag = 1;
|
warning_buffer.flag = 1;
|
warning_buffer.index = 0;
|
warning_buffer.index = 0;
|
cur_error_buffer = &warning_buffer;
|
cur_error_buffer = &warning_buffer;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
error_print (_("Warning:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
error_char ('\0');
|
error_char ('\0');
|
|
|
if (buffer_flag == 0)
|
if (buffer_flag == 0)
|
{
|
{
|
warnings++;
|
warnings++;
|
if (warnings_are_errors)
|
if (warnings_are_errors)
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
}
|
}
|
}
|
}
|
|
|
|
|
/* Immediate error. */
|
/* Immediate error. */
|
|
|
void
|
void
|
gfc_error_now (const char *gmsgid, ...)
|
gfc_error_now (const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
int i;
|
int i;
|
|
|
error_buffer.flag = 1;
|
error_buffer.flag = 1;
|
error_buffer.index = 0;
|
error_buffer.index = 0;
|
cur_error_buffer = &error_buffer;
|
cur_error_buffer = &error_buffer;
|
|
|
i = buffer_flag;
|
i = buffer_flag;
|
buffer_flag = 0;
|
buffer_flag = 0;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print (_("Error:"), _(gmsgid), argp);
|
error_print (_("Error:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
error_char ('\0');
|
error_char ('\0');
|
|
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
|
|
buffer_flag = i;
|
buffer_flag = i;
|
|
|
if (flag_fatal_errors)
|
if (flag_fatal_errors)
|
exit (1);
|
exit (1);
|
}
|
}
|
|
|
|
|
/* Fatal error, never returns. */
|
/* Fatal error, never returns. */
|
|
|
void
|
void
|
gfc_fatal_error (const char *gmsgid, ...)
|
gfc_fatal_error (const char *gmsgid, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
|
|
buffer_flag = 0;
|
buffer_flag = 0;
|
|
|
va_start (argp, gmsgid);
|
va_start (argp, gmsgid);
|
error_print (_("Fatal Error:"), _(gmsgid), argp);
|
error_print (_("Fatal Error:"), _(gmsgid), argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
exit (3);
|
exit (3);
|
}
|
}
|
|
|
|
|
/* This shouldn't happen... but sometimes does. */
|
/* This shouldn't happen... but sometimes does. */
|
|
|
void
|
void
|
gfc_internal_error (const char *format, ...)
|
gfc_internal_error (const char *format, ...)
|
{
|
{
|
va_list argp;
|
va_list argp;
|
|
|
buffer_flag = 0;
|
buffer_flag = 0;
|
|
|
va_start (argp, format);
|
va_start (argp, format);
|
|
|
show_loci (&gfc_current_locus, NULL);
|
show_loci (&gfc_current_locus, NULL);
|
error_printf ("Internal Error at (1):");
|
error_printf ("Internal Error at (1):");
|
|
|
error_print ("", format, argp);
|
error_print ("", format, argp);
|
va_end (argp);
|
va_end (argp);
|
|
|
exit (ICE_EXIT_CODE);
|
exit (ICE_EXIT_CODE);
|
}
|
}
|
|
|
|
|
/* Clear the error flag when we start to compile a source line. */
|
/* Clear the error flag when we start to compile a source line. */
|
|
|
void
|
void
|
gfc_clear_error (void)
|
gfc_clear_error (void)
|
{
|
{
|
error_buffer.flag = 0;
|
error_buffer.flag = 0;
|
warnings_not_errors = 0;
|
warnings_not_errors = 0;
|
}
|
}
|
|
|
|
|
/* Tests the state of error_flag. */
|
/* Tests the state of error_flag. */
|
|
|
int
|
int
|
gfc_error_flag_test (void)
|
gfc_error_flag_test (void)
|
{
|
{
|
return error_buffer.flag;
|
return error_buffer.flag;
|
}
|
}
|
|
|
|
|
/* Check to see if any errors have been saved.
|
/* Check to see if any errors have been saved.
|
If so, print the error. Returns the state of error_flag. */
|
If so, print the error. Returns the state of error_flag. */
|
|
|
int
|
int
|
gfc_error_check (void)
|
gfc_error_check (void)
|
{
|
{
|
int rc;
|
int rc;
|
|
|
rc = error_buffer.flag;
|
rc = error_buffer.flag;
|
|
|
if (error_buffer.flag)
|
if (error_buffer.flag)
|
{
|
{
|
if (error_buffer.message != NULL)
|
if (error_buffer.message != NULL)
|
fputs (error_buffer.message, stderr);
|
fputs (error_buffer.message, stderr);
|
error_buffer.flag = 0;
|
error_buffer.flag = 0;
|
|
|
gfc_increment_error_count();
|
gfc_increment_error_count();
|
|
|
if (flag_fatal_errors)
|
if (flag_fatal_errors)
|
exit (1);
|
exit (1);
|
}
|
}
|
|
|
return rc;
|
return rc;
|
}
|
}
|
|
|
|
|
/* Save the existing error state. */
|
/* Save the existing error state. */
|
|
|
void
|
void
|
gfc_push_error (gfc_error_buf *err)
|
gfc_push_error (gfc_error_buf *err)
|
{
|
{
|
err->flag = error_buffer.flag;
|
err->flag = error_buffer.flag;
|
if (error_buffer.flag)
|
if (error_buffer.flag)
|
err->message = xstrdup (error_buffer.message);
|
err->message = xstrdup (error_buffer.message);
|
|
|
error_buffer.flag = 0;
|
error_buffer.flag = 0;
|
}
|
}
|
|
|
|
|
/* Restore a previous pushed error state. */
|
/* Restore a previous pushed error state. */
|
|
|
void
|
void
|
gfc_pop_error (gfc_error_buf *err)
|
gfc_pop_error (gfc_error_buf *err)
|
{
|
{
|
error_buffer.flag = err->flag;
|
error_buffer.flag = err->flag;
|
if (error_buffer.flag)
|
if (error_buffer.flag)
|
{
|
{
|
size_t len = strlen (err->message) + 1;
|
size_t len = strlen (err->message) + 1;
|
gcc_assert (len <= error_buffer.allocated);
|
gcc_assert (len <= error_buffer.allocated);
|
memcpy (error_buffer.message, err->message, len);
|
memcpy (error_buffer.message, err->message, len);
|
gfc_free (err->message);
|
gfc_free (err->message);
|
}
|
}
|
}
|
}
|
|
|
|
|
/* Free a pushed error state, but keep the current error state. */
|
/* Free a pushed error state, but keep the current error state. */
|
|
|
void
|
void
|
gfc_free_error (gfc_error_buf *err)
|
gfc_free_error (gfc_error_buf *err)
|
{
|
{
|
if (err->flag)
|
if (err->flag)
|
gfc_free (err->message);
|
gfc_free (err->message);
|
}
|
}
|
|
|
|
|
/* Report the number of warnings and errors that occurred to the caller. */
|
/* Report the number of warnings and errors that occurred to the caller. */
|
|
|
void
|
void
|
gfc_get_errors (int *w, int *e)
|
gfc_get_errors (int *w, int *e)
|
{
|
{
|
if (w != NULL)
|
if (w != NULL)
|
*w = warnings;
|
*w = warnings;
|
if (e != NULL)
|
if (e != NULL)
|
*e = errors;
|
*e = errors;
|
}
|
}
|
|
|
|
|
/* Switch errors into warnings. */
|
/* Switch errors into warnings. */
|
|
|
void
|
void
|
gfc_errors_to_warnings (int f)
|
gfc_errors_to_warnings (int f)
|
{
|
{
|
warnings_not_errors = (f == 1) ? 1 : 0;
|
warnings_not_errors = (f == 1) ? 1 : 0;
|
}
|
}
|
|
|
