/* Handle errors.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Contributed by Andy Vaught & Niels Kristian Bech Jensen
#include "flags.h"
#include "gfortran.h"
-int gfc_suppress_error = 0;
+static int suppress_errors = 0;
+
+static int warnings_not_errors = 0;
static int terminal_width, buffer_flag, errors, warnings;
static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
+/* Go one level deeper suppressing errors. */
+
+void
+gfc_push_suppress_errors (void)
+{
+ gcc_assert (suppress_errors >= 0);
+ ++suppress_errors;
+}
+
+
+/* Leave one level of error suppressing. */
+
+void
+gfc_pop_suppress_errors (void)
+{
+ gcc_assert (suppress_errors > 0);
+ --suppress_errors;
+}
+
+
/* Per-file error initialization. */
void
{
cur_error_buffer->allocated = cur_error_buffer->allocated
? cur_error_buffer->allocated * 2 : 1000;
- cur_error_buffer->message = xrealloc (cur_error_buffer->message,
- cur_error_buffer->allocated);
+ cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message,
+ cur_error_buffer->allocated);
}
cur_error_buffer->message[cur_error_buffer->index++] = c;
}
if (index + 1 >= allocated)
{
allocated = allocated ? allocated * 2 : 1000;
- line = xrealloc (line, allocated);
+ line = XRESIZEVEC (char, line, allocated);
}
line[index++] = c;
if (c == '\n')
/* Print a formatted integer to the error buffer or output. */
-#define IBUF_LEN 30
+#define IBUF_LEN 60
static void
-error_integer (int i)
+error_uinteger (unsigned long int i)
{
char *p, int_buf[IBUF_LEN];
- if (i < 0)
- {
- i = -i;
- error_char ('-');
- }
-
p = int_buf + IBUF_LEN - 1;
*p-- = '\0';
error_string (p + 1);
}
+static void
+error_integer (long int i)
+{
+ unsigned long int u;
+
+ if (i < 0)
+ {
+ u = (unsigned long int) -i;
+ error_char ('-');
+ }
+ else
+ u = i;
+
+ error_uinteger (u);
+}
+
+
+static void
+print_wide_char_into_buffer (gfc_char_t c, char *buf)
+{
+ static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
+ '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
+
+ if (gfc_wide_is_printable (c))
+ {
+ buf[1] = '\0';
+ buf[0] = (unsigned char) c;
+ }
+ else if (c < ((gfc_char_t) 1 << 8))
+ {
+ buf[4] = '\0';
+ buf[3] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[2] = xdigit[c & 0x0F];
+
+ buf[1] = 'x';
+ buf[0] = '\\';
+ }
+ else if (c < ((gfc_char_t) 1 << 16))
+ {
+ buf[6] = '\0';
+ buf[5] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[4] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[3] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[2] = xdigit[c & 0x0F];
+
+ buf[1] = 'u';
+ buf[0] = '\\';
+ }
+ else
+ {
+ buf[10] = '\0';
+ buf[9] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[8] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[7] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[6] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[5] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[4] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[3] = xdigit[c & 0x0F];
+ c = c >> 4;
+ buf[2] = xdigit[c & 0x0F];
+
+ buf[1] = 'U';
+ buf[0] = '\\';
+ }
+}
+
+static char wide_char_print_buffer[11];
+
+const char *
+gfc_print_wide_char (gfc_char_t c)
+{
+ print_wide_char_into_buffer (c, wide_char_print_buffer);
+ return wide_char_print_buffer;
+}
+
/* Show the file, where it was included, and the source line, give a
locus. Calls error_printf() recursively, but the recursion is at
{
gfc_linebuf *lb;
gfc_file *f;
- char c, *p;
- int i, m, offset, cmax;
+ gfc_char_t c, *p;
+ int i, offset, cmax;
/* TODO: Either limit the total length and number of included files
displayed or add buffering of arbitrary number of characters in
error_string (f->filename);
error_char (':');
-#ifdef USE_MAPPED_LOCATION
error_integer (LOCATION_LINE (lb->location));
-#else
- error_integer (lb->linenum);
-#endif
if ((c1 > 0) || (c2 > 0))
error_char ('.');
{
i = f->inclusion_line;
- f = f->included_by;
+ f = f->up;
if (f == NULL) break;
error_printf (" Included at %s:%d:", f->filename, i);
offset = 0;
- /* When the loci is not associated with a column, it will have a
- value of zero. We adjust this to 1 so that it will appear. */
-
- if (c1 == 0)
- c1 = 1;
- if (c2 == 0)
- c2 = 1;
-
/* 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
just '1'. We do this here so it will be accounted for in the
to work correctly when nonprintable characters exist. A better
solution should be found. */
- p = lb->line + offset;
- i = strlen (p);
+ p = &(lb->line[offset]);
+ i = gfc_wide_strlen (p);
if (i > terminal_width)
i = terminal_width - 1;
for (; i > 0; i--)
{
+ static char buffer[11];
+
c = *p++;
if (c == '\t')
c = ' ';
- if (ISPRINT (c))
- error_char (c);
- else
- {
- error_char ('\\');
- error_char ('x');
-
- m = ((c >> 4) & 0x0F) + '0';
- if (m > '9')
- m += 'A' - '9' - 1;
- error_char (m);
-
- m = (c & 0x0F) + '0';
- if (m > '9')
- m += 'A' - '9' - 1;
- error_char (m);
- }
+ print_wide_char_into_buffer (c, buffer);
+ error_string (buffer);
}
error_char ('\n');
c1 -= offset;
c2 -= offset;
- for (i = 1; i <= cmax; i++)
+ for (i = 0; i <= cmax; i++)
{
if (i == c1)
error_char ('1');
static void ATTRIBUTE_GCC_GFC(2,0)
error_print (const char *type, const char *format0, va_list argp)
{
- enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_CHAR, TYPE_STRING,
+ enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
+ TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
NOTYPE };
struct
{
union
{
int intval;
+ unsigned int uintval;
+ long int longintval;
+ unsigned long int ulongintval;
char charval;
const char * stringval;
} u;
arg[pos].type = TYPE_INTEGER;
break;
+ case 'u':
+ arg[pos].type = TYPE_UINTEGER;
+ break;
+
+ case 'l':
+ c = *format++;
+ if (c == 'u')
+ arg[pos].type = TYPE_ULONGINT;
+ else if (c == 'i' || c == 'd')
+ arg[pos].type = TYPE_LONGINT;
+ else
+ gcc_unreachable ();
+ break;
+
case 'c':
arg[pos].type = TYPE_CHAR;
break;
arg[pos].u.intval = va_arg (argp, int);
break;
+ case TYPE_UINTEGER:
+ arg[pos].u.uintval = va_arg (argp, unsigned int);
+ break;
+
+ case TYPE_LONGINT:
+ arg[pos].u.longintval = va_arg (argp, long int);
+ break;
+
+ case TYPE_ULONGINT:
+ arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
+ break;
+
case TYPE_CHAR:
arg[pos].u.charval = (char) va_arg (argp, int);
break;
case 'i':
error_integer (spec[n++].u.intval);
break;
+
+ case 'u':
+ error_uinteger (spec[n++].u.uintval);
+ break;
+
+ case 'l':
+ format++;
+ if (*format == 'u')
+ error_uinteger (spec[n++].u.ulongintval);
+ else
+ error_integer (spec[n++].u.longintval);
+ break;
+
}
}
standard does not contain the requested bits. Return FAILURE if
an error is generated. */
-try
+gfc_try
gfc_notify_std (int std, const char *nocmsgid, ...)
{
va_list argp;
if ((gfc_option.allow_std & std) != 0 && !warning)
return SUCCESS;
- if (gfc_suppress_error)
+ if (suppress_errors)
return warning ? SUCCESS : FAILURE;
- cur_error_buffer = (warning && !warnings_are_errors)
- ? &warning_buffer : &error_buffer;
+ cur_error_buffer = warning ? &warning_buffer : &error_buffer;
cur_error_buffer->flag = 1;
cur_error_buffer->index = 0;
i = buffer_flag;
buffer_flag = 0;
warnings++;
- if (warnings_are_errors)
- gfc_increment_error_count();
va_start (argp, nocmsgid);
error_print (_("Warning:"), _(nocmsgid), argp);
va_end (argp);
error_char ('\0');
+
+ if (warnings_are_errors)
+ gfc_increment_error_count();
+
buffer_flag = i;
}
{
va_list argp;
- if (gfc_suppress_error)
+ if (warnings_not_errors)
+ goto warning;
+
+ if (suppress_errors)
return;
error_buffer.flag = 1;
if (buffer_flag == 0)
gfc_increment_error_count();
+
+ return;
+
+warning:
+
+ if (inhibit_warnings)
+ return;
+
+ warning_buffer.flag = 1;
+ warning_buffer.index = 0;
+ cur_error_buffer = &warning_buffer;
+
+ va_start (argp, nocmsgid);
+ error_print (_("Warning:"), _(nocmsgid), argp);
+ va_end (argp);
+
+ error_char ('\0');
+
+ if (buffer_flag == 0)
+ {
+ warnings++;
+ if (warnings_are_errors)
+ gfc_increment_error_count();
+ }
}
gfc_clear_error (void)
{
error_buffer.flag = 0;
+ warnings_not_errors = 0;
}
}
-/* Debug wrapper for printf. */
-
-void
-gfc_status (const char *cmsgid, ...)
-{
- va_list argp;
-
- va_start (argp, cmsgid);
-
- vprintf (_(cmsgid), argp);
-
- va_end (argp);
-}
-
-
-/* Subroutine for outputting a single char so that we don't have to go
- around creating a lot of 1-character strings. */
-
-void
-gfc_status_char (char c)
-{
- putchar (c);
-}
-
-
/* Report the number of warnings and errors that occurred to the caller. */
void
if (e != NULL)
*e = errors;
}
+
+
+/* Switch errors into warnings. */
+
+void
+gfc_errors_to_warnings (int f)
+{
+ warnings_not_errors = (f == 1) ? 1 : 0;
+}
OSDN Git Service
