#include "config.h"
#include "system.h"
#include "flags.h"
#include "gfortran.h"
int gfc_suppress_error = 0;
static int terminal_width, buffer_flag, errors,
use_warning_buffer, warnings;
static char *error_ptr, *warning_ptr;
static gfc_error_buf error_buffer, warning_buffer;
void
gfc_error_init_1 (void)
{
terminal_width = gfc_terminal_width ();
errors = 0;
warnings = 0;
buffer_flag = 0;
}
void
gfc_buffer_error (int flag)
{
buffer_flag = flag;
}
static void
error_char (char c)
{
if (buffer_flag)
{
if (use_warning_buffer)
{
*warning_ptr++ = c;
if (warning_ptr - warning_buffer.message >= MAX_ERROR_MESSAGE)
gfc_internal_error ("error_char(): Warning buffer overflow");
}
else
{
*error_ptr++ = c;
if (error_ptr - error_buffer.message >= MAX_ERROR_MESSAGE)
gfc_internal_error ("error_char(): Error buffer overflow");
}
}
else
{
if (c != 0)
{
static char line[MAX_ERROR_MESSAGE + 1];
static int index = 0;
line[index++] = c;
if (c == '\n' || index == MAX_ERROR_MESSAGE)
{
line[index] = '\0';
fputs (line, stderr);
index = 0;
}
}
}
}
static void
error_string (const char *p)
{
while (*p)
error_char (*p++);
}
static void error_printf (const char *, ...) ATTRIBUTE_PRINTF_1;
static void
show_locus (int offset, locus * loc)
{
gfc_linebuf *lb;
gfc_file *f;
char c, *p;
int i, m;
lb = loc->lb;
f = lb->file;
error_printf ("In file %s:%d\n", f->filename,
#ifdef USE_MAPPED_LOCATION
LOCATION_LINE (lb->location)
#else
lb->linenum
#endif
);
for (;;)
{
i = f->inclusion_line;
f = f->included_by;
if (f == NULL) break;
error_printf (" Included at %s:%d\n", f->filename, i);
}
p = lb->line + offset;
i = strlen (p);
if (i > terminal_width)
i = terminal_width - 1;
for (; i > 0; i--)
{
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);
}
}
error_char ('\n');
}
static void
show_loci (locus * l1, locus * l2)
{
int offset, flag, i, m, c1, c2, cmax;
if (l1 == NULL)
{
error_printf ("<During initialization>\n");
return;
}
c1 = l1->nextc - l1->lb->line;
c2 = 0;
if (l2 == NULL)
goto separate;
c2 = l2->nextc - l2->lb->line;
if (c1 < c2)
m = c2 - c1;
else
m = c1 - c2;
if (l1->lb != l2->lb || m > terminal_width - 10)
goto separate;
offset = 0;
cmax = (c1 < c2) ? c2 : c1;
if (cmax > terminal_width - 5)
offset = cmax - terminal_width + 5;
if (offset < 0)
offset = 0;
c1 -= offset;
c2 -= offset;
show_locus (offset, l1);
for (i = 1; i <= cmax; i++)
{
flag = 0;
if (i == c1)
{
error_char ('1');
flag = 1;
}
if (i == c2)
{
error_char ('2');
flag = 1;
}
if (flag == 0)
error_char (' ');
}
error_char ('\n');
return;
separate:
offset = 0;
if (c1 > terminal_width - 5)
{
offset = c1 - 5;
if (offset < 0)
offset = 0;
c1 = c1 - offset;
}
show_locus (offset, l1);
for (i = 1; i < c1; i++)
error_char (' ');
error_char ('1');
error_char ('\n');
if (l2 != NULL)
{
offset = 0;
if (c2 > terminal_width - 20)
{
offset = c2 - 20;
if (offset < 0)
offset = 0;
c2 = c2 - offset;
}
show_locus (offset, l2);
for (i = 1; i < c2; i++)
error_char (' ');
error_char ('2');
error_char ('\n');
}
}
#define IBUF_LEN 30
#define MAX_ARGS 10
static void
error_print (const char *type, const char *format0, va_list argp)
{
char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS];
int i, n, have_l1, i_arg[MAX_ARGS];
locus *l1, *l2, *loc;
const char *format;
l1 = l2 = loc = NULL;
have_l1 = 0;
n = 0;
format = format0;
while (*format)
{
c = *format++;
if (c == '%')
{
c = *format++;
switch (c)
{
case '%':
break;
case 'L':
loc = va_arg (argp, locus *);
case 'C':
if (c == 'C')
loc = &gfc_current_locus;
if (have_l1)
{
l2 = loc;
}
else
{
l1 = loc;
have_l1 = 1;
}
break;
case 'd':
case 'i':
i_arg[n++] = va_arg (argp, int);
break;
case 'c':
c_arg[n++] = va_arg (argp, int);
break;
case 's':
cp_arg[n++] = va_arg (argp, char *);
break;
}
}
}
if (have_l1)
show_loci (l1, l2);
error_string (type);
error_char (' ');
have_l1 = 0;
format = format0;
n = 0;
for (; *format; format++)
{
if (*format != '%')
{
error_char (*format);
continue;
}
format++;
switch (*format)
{
case '%':
error_char ('%');
break;
case 'c':
error_char (c_arg[n++]);
break;
case 's':
error_string (cp_arg[n++]);
break;
case 'i':
case 'd':
i = i_arg[n++];
if (i < 0)
{
i = -i;
error_char ('-');
}
p = int_buf + IBUF_LEN - 1;
*p-- = '\0';
if (i == 0)
*p-- = '0';
while (i > 0)
{
*p-- = i % 10 + '0';
i = i / 10;
}
error_string (p + 1);
break;
case 'C':
case 'L':
error_string (have_l1 ? "(2)" : "(1)");
have_l1 = 1;
break;
}
}
error_char ('\n');
}
static void
error_printf (const char *format, ...)
{
va_list argp;
va_start (argp, format);
error_print ("", format, argp);
va_end (argp);
}
void
gfc_warning (const char *format, ...)
{
va_list argp;
if (inhibit_warnings)
return;
warning_buffer.flag = 1;
warning_ptr = warning_buffer.message;
use_warning_buffer = 1;
va_start (argp, format);
if (buffer_flag == 0)
warnings++;
error_print ("Warning:", format, argp);
va_end (argp);
error_char ('\0');
}
try
gfc_notify_std (int std, const char *format, ...)
{
va_list argp;
bool warning;
warning = ((gfc_option.warn_std & std) != 0)
&& !inhibit_warnings;
if ((gfc_option.allow_std & std) != 0
&& !warning)
return SUCCESS;
if (gfc_suppress_error)
return warning ? SUCCESS : FAILURE;
if (warning)
{
warning_buffer.flag = 1;
warning_ptr = warning_buffer.message;
use_warning_buffer = 1;
}
else
{
error_buffer.flag = 1;
error_ptr = error_buffer.message;
use_warning_buffer = 0;
}
if (buffer_flag == 0)
{
if (warning)
warnings++;
else
errors++;
}
va_start (argp, format);
if (warning)
error_print ("Warning:", format, argp);
else
error_print ("Error:", format, argp);
va_end (argp);
error_char ('\0');
return warning ? SUCCESS : FAILURE;
}
void
gfc_warning_now (const char *format, ...)
{
va_list argp;
int i;
if (inhibit_warnings)
return;
i = buffer_flag;
buffer_flag = 0;
warnings++;
va_start (argp, format);
error_print ("Warning:", format, argp);
va_end (argp);
error_char ('\0');
buffer_flag = i;
}
void
gfc_clear_warning (void)
{
warning_buffer.flag = 0;
}
void
gfc_warning_check (void)
{
if (warning_buffer.flag)
{
warnings++;
fputs (warning_buffer.message, stderr);
warning_buffer.flag = 0;
}
}
void
gfc_error (const char *format, ...)
{
va_list argp;
if (gfc_suppress_error)
return;
error_buffer.flag = 1;
error_ptr = error_buffer.message;
use_warning_buffer = 0;
va_start (argp, format);
if (buffer_flag == 0)
errors++;
error_print ("Error:", format, argp);
va_end (argp);
error_char ('\0');
}
void
gfc_error_now (const char *format, ...)
{
va_list argp;
int i;
error_buffer.flag = 1;
error_ptr = error_buffer.message;
i = buffer_flag;
buffer_flag = 0;
errors++;
va_start (argp, format);
error_print ("Error:", format, argp);
va_end (argp);
error_char ('\0');
buffer_flag = i;
}
void
gfc_fatal_error (const char *format, ...)
{
va_list argp;
buffer_flag = 0;
va_start (argp, format);
error_print ("Fatal Error:", format, argp);
va_end (argp);
exit (3);
}
void
gfc_internal_error (const char *format, ...)
{
va_list argp;
buffer_flag = 0;
va_start (argp, format);
show_loci (&gfc_current_locus, NULL);
error_printf ("Internal Error at (1):");
error_print ("", format, argp);
va_end (argp);
exit (4);
}
void
gfc_clear_error (void)
{
error_buffer.flag = 0;
}
int
gfc_error_check (void)
{
int rc;
rc = error_buffer.flag;
if (error_buffer.flag)
{
errors++;
fputs (error_buffer.message, stderr);
error_buffer.flag = 0;
}
return rc;
}
void
gfc_push_error (gfc_error_buf * err)
{
err->flag = error_buffer.flag;
if (error_buffer.flag)
strcpy (err->message, error_buffer.message);
error_buffer.flag = 0;
}
void
gfc_pop_error (gfc_error_buf * err)
{
error_buffer.flag = err->flag;
if (error_buffer.flag)
strcpy (error_buffer.message, err->message);
}
void
gfc_status (const char *format, ...)
{
va_list argp;
va_start (argp, format);
vprintf (format, argp);
va_end (argp);
}
void
gfc_status_char (char c)
{
putchar (c);
}
void
gfc_get_errors (int *w, int *e)
{
if (w != NULL)
*w = warnings;
if (e != NULL)
*e = errors;
}