Skip to content

R
riscv-gcc-1
Commit 1028b2bd by Janne Blomqvist
Options

Error printing thread safety, remove GFORTRAN_USE_STDERR 

From-SVN: r173749
parent b4224aec
Showing with 267 additions and 197 deletions
gcc/fortran/ChangeLog
2011-05-14 Janne Blomqvist <jb@gcc.gnu.org>
* gfortran.texi: Remove GFORTRAN_USE_STDERR documentation.
2011-05-13 Tobias Burnus <burnus@net-b.de> 2011-05-13 Tobias Burnus <burnus@net-b.de>
PR fortran/48972 PR fortran/48972
......
gcc/fortran/gfortran.texi
...@@ -579,7 +579,6 @@ Malformed environment variables are silently ignored. ...@@ -579,7 +579,6 @@ Malformed environment variables are silently ignored.
* GFORTRAN_STDIN_UNIT:: Unit number for standard input * GFORTRAN_STDIN_UNIT:: Unit number for standard input
* GFORTRAN_STDOUT_UNIT:: Unit number for standard output * GFORTRAN_STDOUT_UNIT:: Unit number for standard output
* GFORTRAN_STDERR_UNIT:: Unit number for standard error * GFORTRAN_STDERR_UNIT:: Unit number for standard error
* GFORTRAN_USE_STDERR:: Send library output to standard error
* GFORTRAN_TMPDIR:: Directory for scratch files * GFORTRAN_TMPDIR:: Directory for scratch files
* GFORTRAN_UNBUFFERED_ALL:: Don't buffer I/O for all units. * GFORTRAN_UNBUFFERED_ALL:: Don't buffer I/O for all units.
* GFORTRAN_UNBUFFERED_PRECONNECTED:: Don't buffer I/O for preconnected units. * GFORTRAN_UNBUFFERED_PRECONNECTED:: Don't buffer I/O for preconnected units.
...@@ -613,14 +612,6 @@ This environment variable can be used to select the unit number ...@@ -613,14 +612,6 @@ This environment variable can be used to select the unit number
preconnected to standard error. This must be a positive integer. preconnected to standard error. This must be a positive integer.
The default value is 0. The default value is 0.
@node GFORTRAN_USE_STDERR
@section @env{GFORTRAN_USE_STDERR}---Send library output to standard error
This environment variable controls where library output is sent.
If the first letter is @samp{y}, @samp{Y} or @samp{1}, standard
error is used. If the first letter is @samp{n}, @samp{N} or
@samp{0}, standard output is used.
@node GFORTRAN_TMPDIR @node GFORTRAN_TMPDIR
@section @env{GFORTRAN_TMPDIR}---Directory for scratch files @section @env{GFORTRAN_TMPDIR}---Directory for scratch files
......
libgfortran/ChangeLog
2011-05-14 Janne Blomqvist <jb@gcc.gnu.org>
* io/unix.c (st_vprintf,st_printf): Move to runtime/error.c.
* libgfortran.h (struct options_t): Remove use_stderr field.
(st_vprintf,st_printf): Move prototypes.
(estr_write): New prototype.
* runtime/error.c (sys_exit): Use estr_write instead of st_printf.
(estr_write): New function.
(st_vprintf): Move from io/unix.c, use stack allocated buffer,
always output to stderr.
(st_printf): Move from io/unix.c.
(show_locus): Use a local variable instead of static.
(os_error): Use estr_write instead of st_printf.
(runtime_error): Likewise.
(runtime_error_at): Likewise.
(runtime_warning_at): Likewise.
(internal_error): Likewise.
(generate_error): Likewise.
(generate_warning): Likewise.
(notify_std): Likewise.
* runtime/pause.c (do_pause): Likewise.
(pause_string): Likewise.
* runtime/stop.c (stop_string): Likewise.
(error_stop_string): Likewise.
* config/fpu_aix.h (set_fpu): Likewise.
* config/fpu_generic.h (set_fpu): Likewise.
* config/fpu_glibc.h (set_fpu): Likewise.
* config/fpu-sysv.h (set_fpu): Likewise.
* runtime/backtrace.c (dump_glibc_backtrace): Likewise.
(show_backtrace): Likewise.
* runtime/environ.c (print_spaces): Likewise.
(show_string): Likewise.
(show_variables): Likewise.
(variable_table[]): Remove GFORTRAN_USE_STDERR entry.
2011-05-14 Tobias Burnus <burnus@net-b.de> 2011-05-14 Tobias Burnus <burnus@net-b.de>
PR fortran/48961 PR fortran/48961
......
libgfortran/config/fpu-aix.h
/* AIX FPU-related code. /* AIX FPU-related code.
Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Copyright 2005, 2007, 2009, 2011 Free Software Foundation, Inc.
Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public modify it under the terms of the GNU General Public
...@@ -38,44 +38,44 @@ set_fpu (void) ...@@ -38,44 +38,44 @@ set_fpu (void)
#ifdef TRP_INVALID #ifdef TRP_INVALID
mode |= TRP_INVALID; mode |= TRP_INVALID;
#else #else
st_printf ("Fortran runtime warning: IEEE 'invalid operation' " estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_DENORMAL) if (options.fpe & GFC_FPE_DENORMAL)
st_printf ("Fortran runtime warning: IEEE 'denormal number' " estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n"); "exception not supported.\n");
if (options.fpe & GFC_FPE_ZERO) if (options.fpe & GFC_FPE_ZERO)
#ifdef TRP_DIV_BY_ZERO #ifdef TRP_DIV_BY_ZERO
mode |= TRP_DIV_BY_ZERO; mode |= TRP_DIV_BY_ZERO;
#else #else
st_printf ("Fortran runtime warning: IEEE 'division by zero' " estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_OVERFLOW) if (options.fpe & GFC_FPE_OVERFLOW)
#ifdef TRP_OVERFLOW #ifdef TRP_OVERFLOW
mode |= TRP_OVERFLOW; mode |= TRP_OVERFLOW;
#else #else
st_printf ("Fortran runtime warning: IEEE 'overflow' " estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_UNDERFLOW) if (options.fpe & GFC_FPE_UNDERFLOW)
#ifdef TRP_UNDERFLOW #ifdef TRP_UNDERFLOW
mode |= TRP_UNDERFLOW; mode |= TRP_UNDERFLOW;
#else #else
st_printf ("Fortran runtime warning: IEEE 'underflow' " estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_PRECISION) if (options.fpe & GFC_FPE_PRECISION)
#ifdef TRP_UNDERFLOW #ifdef TRP_UNDERFLOW
mode |= TRP_UNDERFLOW; mode |= TRP_UNDERFLOW;
#else #else
st_printf ("Fortran runtime warning: IEEE 'loss of precision' " estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
fp_trap(FP_TRAP_SYNC); fp_trap(FP_TRAP_SYNC);
......
libgfortran/config/fpu-generic.h
/* Fallback FPU-related code (for systems not otherwise supported). /* Fallback FPU-related code (for systems not otherwise supported).
Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Copyright 2005, 2007, 2009, 2011 Free Software Foundation, Inc.
Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public modify it under the terms of the GNU General Public
...@@ -32,21 +32,21 @@ void ...@@ -32,21 +32,21 @@ void
set_fpu (void) set_fpu (void)
{ {
if (options.fpe & GFC_FPE_INVALID) if (options.fpe & GFC_FPE_INVALID)
st_printf ("Fortran runtime warning: IEEE 'invalid operation' " estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n"); "exception not supported.\n");
if (options.fpe & GFC_FPE_DENORMAL) if (options.fpe & GFC_FPE_DENORMAL)
st_printf ("Fortran runtime warning: IEEE 'denormal number' " estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n"); "exception not supported.\n");
if (options.fpe & GFC_FPE_ZERO) if (options.fpe & GFC_FPE_ZERO)
st_printf ("Fortran runtime warning: IEEE 'division by zero' " estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n"); "exception not supported.\n");
if (options.fpe & GFC_FPE_OVERFLOW) if (options.fpe & GFC_FPE_OVERFLOW)
st_printf ("Fortran runtime warning: IEEE 'overflow' " estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n"); "exception not supported.\n");
if (options.fpe & GFC_FPE_UNDERFLOW) if (options.fpe & GFC_FPE_UNDERFLOW)
st_printf ("Fortran runtime warning: IEEE 'underflow' " estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n"); "exception not supported.\n");
if (options.fpe & GFC_FPE_PRECISION) if (options.fpe & GFC_FPE_PRECISION)
st_printf ("Fortran runtime warning: IEEE 'loss of precision' " estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n"); "exception not supported.\n");
} }
libgfortran/config/fpu-glibc.h
/* FPU-related code for systems with GNU libc. /* FPU-related code for systems with GNU libc.
Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Copyright 2005, 2007, 2009, 2011 Free Software Foundation, Inc.
Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public modify it under the terms of the GNU General Public
...@@ -40,8 +40,8 @@ void set_fpu (void) ...@@ -40,8 +40,8 @@ void set_fpu (void)
#ifdef FE_INVALID #ifdef FE_INVALID
feenableexcept (FE_INVALID); feenableexcept (FE_INVALID);
#else #else
st_printf ("Fortran runtime warning: IEEE 'invalid operation' " estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
/* glibc does never have a FE_DENORMAL. */ /* glibc does never have a FE_DENORMAL. */
...@@ -49,39 +49,39 @@ void set_fpu (void) ...@@ -49,39 +49,39 @@ void set_fpu (void)
#ifdef FE_DENORMAL #ifdef FE_DENORMAL
feenableexcept (FE_DENORMAL); feenableexcept (FE_DENORMAL);
#else #else
st_printf ("Fortran runtime warning: IEEE 'denormal number' " estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_ZERO) if (options.fpe & GFC_FPE_ZERO)
#ifdef FE_DIVBYZERO #ifdef FE_DIVBYZERO
feenableexcept (FE_DIVBYZERO); feenableexcept (FE_DIVBYZERO);
#else #else
st_printf ("Fortran runtime warning: IEEE 'division by zero' " estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_OVERFLOW) if (options.fpe & GFC_FPE_OVERFLOW)
#ifdef FE_OVERFLOW #ifdef FE_OVERFLOW
feenableexcept (FE_OVERFLOW); feenableexcept (FE_OVERFLOW);
#else #else
st_printf ("Fortran runtime warning: IEEE 'overflow' " estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_UNDERFLOW) if (options.fpe & GFC_FPE_UNDERFLOW)
#ifdef FE_UNDERFLOW #ifdef FE_UNDERFLOW
feenableexcept (FE_UNDERFLOW); feenableexcept (FE_UNDERFLOW);
#else #else
st_printf ("Fortran runtime warning: IEEE 'underflow' " estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_PRECISION) if (options.fpe & GFC_FPE_PRECISION)
#ifdef FE_INEXACT #ifdef FE_INEXACT
feenableexcept (FE_INEXACT); feenableexcept (FE_INEXACT);
#else #else
st_printf ("Fortran runtime warning: IEEE 'loss of precision' " estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
} }
libgfortran/config/fpu-sysv.h
/* SysV FPU-related code (for systems not otherwise supported). /* SysV FPU-related code (for systems not otherwise supported).
Copyright 2005, 2007, 2009 Free Software Foundation, Inc. Copyright 2005, 2007, 2009, 2011 Free Software Foundation, Inc.
Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr> Contributed by Francois-Xavier Coudert <coudert@clipper.ens.fr>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public modify it under the terms of the GNU General Public
...@@ -34,48 +34,48 @@ set_fpu (void) ...@@ -34,48 +34,48 @@ set_fpu (void)
#ifdef FP_X_INV #ifdef FP_X_INV
cw |= FP_X_INV; cw |= FP_X_INV;
#else #else
st_printf ("Fortran runtime warning: IEEE 'invalid operation' " estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_DENORMAL) if (options.fpe & GFC_FPE_DENORMAL)
#ifdef FP_X_DNML #ifdef FP_X_DNML
cw |= FP_X_DNML; cw |= FP_X_DNML;
#else #else
st_printf ("Fortran runtime warning: IEEE 'denormal number' " estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_ZERO) if (options.fpe & GFC_FPE_ZERO)
#ifdef FP_X_DZ #ifdef FP_X_DZ
cw |= FP_X_DZ; cw |= FP_X_DZ;
#else #else
st_printf ("Fortran runtime warning: IEEE 'division by zero' " estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_OVERFLOW) if (options.fpe & GFC_FPE_OVERFLOW)
#ifdef FP_X_OFL #ifdef FP_X_OFL
cw |= FP_X_OFL; cw |= FP_X_OFL;
#else #else
st_printf ("Fortran runtime warning: IEEE 'overflow' " estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_UNDERFLOW) if (options.fpe & GFC_FPE_UNDERFLOW)
#ifdef FP_X_UFL #ifdef FP_X_UFL
cw |= FP_X_UFL; cw |= FP_X_UFL;
#else #else
st_printf ("Fortran runtime warning: IEEE 'underflow' " estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
if (options.fpe & GFC_FPE_PRECISION) if (options.fpe & GFC_FPE_PRECISION)
#ifdef FP_X_IMP #ifdef FP_X_IMP
cw |= FP_X_IMP; cw |= FP_X_IMP;
#else #else
st_printf ("Fortran runtime warning: IEEE 'loss of precision' " estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n"); "exception not supported.\n");
#endif #endif
fpsetmask(cw); fpsetmask(cw);
......
libgfortran/io/unix.c
...@@ -1353,61 +1353,6 @@ error_stream (void) ...@@ -1353,61 +1353,6 @@ error_stream (void)
} }
/* st_vprintf()-- vprintf function for error output. To avoid buffer
overruns, we limit the length of the buffer to ST_VPRINTF_SIZE. 2k
is big enough to completely fill a 80x25 terminal, so it shuld be
OK. We use a direct write() because it is simpler and least likely
to be clobbered by memory corruption. Writing an error message
longer than that is an error. */
#define ST_VPRINTF_SIZE 2048
int
st_vprintf (const char *format, va_list ap)
{
static char buffer[ST_VPRINTF_SIZE];
int written;
int fd;
fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
#ifdef HAVE_VSNPRINTF
written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
#else
written = vsprintf(buffer, format, ap);
if (written >= ST_VPRINTF_SIZE-1)
{
/* The error message was longer than our buffer. Ouch. Because
we may have messed up things badly, report the error and
quit. */
#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n"
write (fd, buffer, ST_VPRINTF_SIZE-1);
write (fd, ERROR_MESSAGE, strlen(ERROR_MESSAGE));
sys_exit(2);
#undef ERROR_MESSAGE
}
#endif
written = write (fd, buffer, written);
return written;
}
/* st_printf()-- printf() function for error output. This just calls
st_vprintf() to do the actual work. */
int
st_printf (const char *format, ...)
{
int written;
va_list ap;
va_start (ap, format);
written = st_vprintf(format, ap);
va_end (ap);
return written;
}
/* compare_file_filename()-- Given an open stream and a fortran string /* compare_file_filename()-- Given an open stream and a fortran string
* that is a filename, figure out if the file is the same as the * that is a filename, figure out if the file is the same as the
* filename. */ * filename. */
......
libgfortran/libgfortran.h
...@@ -508,7 +508,7 @@ typedef struct ...@@ -508,7 +508,7 @@ typedef struct
int separator_len; int separator_len;
const char *separator; const char *separator;
int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl; int all_unbuffered, unbuffered_preconnected, default_recl;
int fpe, dump_core, backtrace; int fpe, dump_core, backtrace;
} }
options_t; options_t;
...@@ -691,6 +691,16 @@ internal_proto(show_backtrace); ...@@ -691,6 +691,16 @@ internal_proto(show_backtrace);
extern void sys_exit (int) __attribute__ ((noreturn)); extern void sys_exit (int) __attribute__ ((noreturn));
internal_proto(sys_exit); internal_proto(sys_exit);
extern ssize_t estr_write (const char *);
internal_proto(estr_write);
extern int st_vprintf (const char *, va_list);
internal_proto(st_vprintf);
extern int st_printf (const char *, ...)
__attribute__((format (gfc_printf, 1, 2)));
internal_proto(st_printf);
extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t); extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
internal_proto(gfc_xtoa); internal_proto(gfc_xtoa);
...@@ -792,13 +802,6 @@ internal_proto(close_units); ...@@ -792,13 +802,6 @@ internal_proto(close_units);
extern int unit_to_fd (int); extern int unit_to_fd (int);
internal_proto(unit_to_fd); internal_proto(unit_to_fd);
extern int st_printf (const char *, ...)
__attribute__ ((format (gfc_printf, 1, 2)));
internal_proto(st_printf);
extern int st_vprintf (const char *, va_list);
internal_proto(st_vprintf);
extern char * filename_from_unit (int); extern char * filename_from_unit (int);
internal_proto(filename_from_unit); internal_proto(filename_from_unit);
......
libgfortran/runtime/backtrace.c
...@@ -95,7 +95,11 @@ dump_glibc_backtrace (int depth, char *str[]) ...@@ -95,7 +95,11 @@ dump_glibc_backtrace (int depth, char *str[])
int i; int i;
for (i = 0; i < depth; i++) for (i = 0; i < depth; i++)
st_printf (" + %s\n", str[i]); {
estr_write (" + ");
estr_write (str[i]);
estr_write ("\n");
}
free (str); free (str);
} }
...@@ -192,7 +196,7 @@ show_backtrace (void) ...@@ -192,7 +196,7 @@ show_backtrace (void)
if (fgets (func, sizeof(func), output)) if (fgets (func, sizeof(func), output))
{ {
st_printf ("\nBacktrace for this error:\n"); estr_write ("\nBacktrace for this error:\n");
do do
{ {
...@@ -222,7 +226,9 @@ show_backtrace (void) ...@@ -222,7 +226,9 @@ show_backtrace (void)
if (func[0] == '?' && func[1] == '?' && file[0] == '?' if (func[0] == '?' && func[1] == '?' && file[0] == '?'
&& file[1] == '?') && file[1] == '?')
{ {
st_printf (" + %s\n", str[i]); estr_write (" + ");
estr_write (str[i]);
estr_write ("\n");
continue; continue;
} }
...@@ -239,15 +245,25 @@ show_backtrace (void) ...@@ -239,15 +245,25 @@ show_backtrace (void)
line = -1; line = -1;
if (strcmp (func, "MAIN__") == 0) if (strcmp (func, "MAIN__") == 0)
st_printf (" + in the main program\n"); estr_write (" + in the main program\n");
else else
st_printf (" + function %s (0x%s)\n", func, addr[i]); {
estr_write (" + function ");
estr_write (func);
estr_write (" (0x");
estr_write (addr[i]);
estr_write (")\n");
}
if (line <= 0 && strcmp (file, "??") == 0) if (line <= 0 && strcmp (file, "??") == 0)
continue; continue;
if (line <= 0) if (line <= 0)
st_printf (" from file %s\n", file); {
estr_write (" from file ");
estr_write (file);
estr_write ("\n");
}
else else
st_printf (" at line %d of file %s\n", line, file); st_printf (" at line %d of file %s\n", line, file);
} }
...@@ -257,8 +273,8 @@ show_backtrace (void) ...@@ -257,8 +273,8 @@ show_backtrace (void)
return; return;
fallback: fallback:
st_printf ("** Something went wrong while running addr2line. **\n" estr_write ("** Something went wrong while running addr2line. **\n"
"** Falling back to a simpler backtrace scheme. **\n"); "** Falling back to a simpler backtrace scheme. **\n");
} }
} }
while (0); while (0);
...@@ -288,7 +304,7 @@ fallback: ...@@ -288,7 +304,7 @@ fallback:
char *arg[NUM_ARGS+1]; char *arg[NUM_ARGS+1];
char buf[20]; char buf[20];
st_printf ("\nBacktrace for this error:\n"); estr_write ("\nBacktrace for this error:\n");
arg[0] = (char *) "pstack"; arg[0] = (char *) "pstack";
snprintf (buf, sizeof(buf), "%d", (int) getppid ()); snprintf (buf, sizeof(buf), "%d", (int) getppid ());
arg[1] = buf; arg[1] = buf;
...@@ -301,7 +317,7 @@ fallback: ...@@ -301,7 +317,7 @@ fallback:
#if GLIBC_BACKTRACE #if GLIBC_BACKTRACE
dump_glibc_backtrace (depth, str); dump_glibc_backtrace (depth, str);
#else #else
st_printf (" unable to produce a backtrace, sorry!\n"); estr_write (" unable to produce a backtrace, sorry!\n");
#endif #endif
_exit (0); _exit (0);
...@@ -316,7 +332,7 @@ fallback: ...@@ -316,7 +332,7 @@ fallback:
#if GLIBC_BACKTRACE #if GLIBC_BACKTRACE
/* Fallback to the glibc backtrace. */ /* Fallback to the glibc backtrace. */
st_printf ("\nBacktrace for this error:\n"); estr_write ("\nBacktrace for this error:\n");
dump_glibc_backtrace (depth, str); dump_glibc_backtrace (depth, str);
#endif #endif
} }
libgfortran/runtime/environ.c
...@@ -71,7 +71,7 @@ print_spaces (int n) ...@@ -71,7 +71,7 @@ print_spaces (int n)
buffer[i] = '\0'; buffer[i] = '\0';
st_printf (buffer); estr_write (buffer);
} }
...@@ -261,7 +261,10 @@ show_string (variable * v) ...@@ -261,7 +261,10 @@ show_string (variable * v)
if (p == NULL) if (p == NULL)
p = ""; p = "";
st_printf ("%s \"%s\"\n", var_source (v), p); estr_write (var_source (v));
estr_write (" \"");
estr_write (p);
estr_write ("\"\n");
} }
...@@ -281,10 +284,6 @@ static variable variable_table[] = { ...@@ -281,10 +284,6 @@ static variable variable_table[] = {
"Unit number that will be preconnected to standard error\n" "Unit number that will be preconnected to standard error\n"
"(No preconnection if negative)", 0}, "(No preconnection if negative)", 0},
{"GFORTRAN_USE_STDERR", 1, &options.use_stderr, init_boolean,
show_boolean,
"Sends library output to standard error instead of standard output.", 0},
{"GFORTRAN_TMPDIR", 0, NULL, init_string, show_string, {"GFORTRAN_TMPDIR", 0, NULL, init_string, show_string,
"Directory for scratch files. Overrides the TMP environment variable\n" "Directory for scratch files. Overrides the TMP environment variable\n"
"If TMP is not set " DEFAULT_TEMPDIR " is used.", 0}, "If TMP is not set " DEFAULT_TEMPDIR " is used.", 0},
...@@ -352,32 +351,33 @@ show_variables (void) ...@@ -352,32 +351,33 @@ show_variables (void)
int n; int n;
/* TODO: print version number. */ /* TODO: print version number. */
st_printf ("GNU Fortran 95 runtime library version " estr_write ("GNU Fortran runtime library version "
"UNKNOWN" "\n\n"); "UNKNOWN" "\n\n");
st_printf ("Environment variables:\n"); estr_write ("Environment variables:\n");
st_printf ("----------------------\n"); estr_write ("----------------------\n");
for (v = variable_table; v->name; v++) for (v = variable_table; v->name; v++)
{ {
n = st_printf ("%s", v->name); n = estr_write (v->name);
print_spaces (25 - n); print_spaces (25 - n);
if (v->show == show_integer) if (v->show == show_integer)
st_printf ("Integer "); estr_write ("Integer ");
else if (v->show == show_boolean) else if (v->show == show_boolean)
st_printf ("Boolean "); estr_write ("Boolean ");
else else
st_printf ("String "); estr_write ("String ");
v->show (v); v->show (v);
st_printf ("%s\n\n", v->desc); estr_write (v->desc);
estr_write ("\n\n");
} }
/* System error codes */ /* System error codes */
st_printf ("\nRuntime error codes:"); estr_write ("\nRuntime error codes:");
st_printf ("\n--------------------\n"); estr_write ("\n--------------------\n");
for (n = LIBERROR_FIRST + 1; n < LIBERROR_LAST; n++) for (n = LIBERROR_FIRST + 1; n < LIBERROR_LAST; n++)
if (n < 0 || n > 9) if (n < 0 || n > 9)
...@@ -385,10 +385,8 @@ show_variables (void) ...@@ -385,10 +385,8 @@ show_variables (void)
else else
st_printf (" %d %s\n", n, translate_error (n)); st_printf (" %d %s\n", n, translate_error (n));
st_printf ("\nCommand line arguments:\n"); estr_write ("\nCommand line arguments:\n");
st_printf (" --help Print this list\n"); estr_write (" --help Print this list\n");
/* st_printf(" --resume <dropfile> Resume program execution from dropfile\n"); */
sys_exit (0); sys_exit (0);
} }
......
libgfortran/runtime/error.c
...@@ -81,7 +81,7 @@ sys_exit (int code) ...@@ -81,7 +81,7 @@ sys_exit (int code)
struct rlimit core_limit; struct rlimit core_limit;
if (getrlimit (RLIMIT_CORE, &core_limit) == 0 && core_limit.rlim_cur == 0) if (getrlimit (RLIMIT_CORE, &core_limit) == 0 && core_limit.rlim_cur == 0)
st_printf ("** Warning: a core dump was requested, but the core size" estr_write ("** Warning: a core dump was requested, but the core size"
"limit\n** is currently zero.\n\n"); "limit\n** is currently zero.\n\n");
#endif #endif
...@@ -89,7 +89,7 @@ sys_exit (int code) ...@@ -89,7 +89,7 @@ sys_exit (int code)
#if defined(HAVE_KILL) && defined(HAVE_GETPID) && defined(SIGQUIT) #if defined(HAVE_KILL) && defined(HAVE_GETPID) && defined(SIGQUIT)
kill (getpid (), SIGQUIT); kill (getpid (), SIGQUIT);
#else #else
st_printf ("Core dump not possible, sorry."); estr_write ("Core dump not possible, sorry.");
#endif #endif
} }
...@@ -112,6 +112,67 @@ sys_exit (int code) ...@@ -112,6 +112,67 @@ sys_exit (int code)
* Other error returns are reserved for the STOP statement with a numeric code. * Other error returns are reserved for the STOP statement with a numeric code.
*/ */
/* Write a null-terminated C string to standard error. This function
is async-signal-safe. */
ssize_t
estr_write (const char *str)
{
return write (STDERR_FILENO, str, strlen (str));
}
/* st_vprintf()-- vsnprintf-like function for error output. We use a
stack allocated buffer for formatting; since this function might be
called from within a signal handler, printing directly to stderr
with vfprintf is not safe since the stderr locking might lead to a
deadlock. */
#define ST_VPRINTF_SIZE 512
int
st_vprintf (const char *format, va_list ap)
{
int written;
char buffer[ST_VPRINTF_SIZE];
#ifdef HAVE_VSNPRINTF
written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
#else
written = vsprintf(buffer, format, ap);
if (written >= ST_VPRINTF_SIZE - 1)
{
/* The error message was longer than our buffer. Ouch. Because
we may have messed up things badly, report the error and
quit. */
#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n"
write (STDERR_FILENO, buffer, ST_VPRINTF_SIZE - 1);
write (STDERR_FILENO, ERROR_MESSAGE, strlen(ERROR_MESSAGE));
sys_exit(2);
#undef ERROR_MESSAGE
}
#endif
written = write (STDERR_FILENO, buffer, written);
return written;
}
int
st_printf (const char * format, ...)
{
int written;
va_list ap;
va_start (ap, format);
written = st_vprintf (format, ap);
va_end (ap);
return written;
}
/* gfc_xtoa()-- Integer to hexadecimal conversion. */ /* gfc_xtoa()-- Integer to hexadecimal conversion. */
const char * const char *
...@@ -177,7 +238,7 @@ gf_strerror (int errnum, ...@@ -177,7 +238,7 @@ gf_strerror (int errnum,
void void
show_locus (st_parameter_common *cmp) show_locus (st_parameter_common *cmp)
{ {
static char *filename; char *filename;
if (!options.locus || cmp == NULL || cmp->filename == NULL) if (!options.locus || cmp == NULL || cmp->filename == NULL)
return; return;
...@@ -185,6 +246,7 @@ show_locus (st_parameter_common *cmp) ...@@ -185,6 +246,7 @@ show_locus (st_parameter_common *cmp)
if (cmp->unit > 0) if (cmp->unit > 0)
{ {
filename = filename_from_unit (cmp->unit); filename = filename_from_unit (cmp->unit);
if (filename != NULL) if (filename != NULL)
{ {
st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", st_printf ("At line %d of file %s (unit = %d, file = '%s')\n",
...@@ -233,8 +295,11 @@ os_error (const char *message) ...@@ -233,8 +295,11 @@ os_error (const char *message)
{ {
char errmsg[STRERR_MAXSZ]; char errmsg[STRERR_MAXSZ];
recursion_check (); recursion_check ();
st_printf ("Operating system error: %s\n%s\n", estr_write ("Operating system error: ");
gf_strerror (errno, errmsg, STRERR_MAXSZ), message); estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ));
estr_write ("\n");
estr_write (message);
estr_write ("\n");
sys_exit (1); sys_exit (1);
} }
iexport(os_error); iexport(os_error);
...@@ -249,11 +314,11 @@ runtime_error (const char *message, ...) ...@@ -249,11 +314,11 @@ runtime_error (const char *message, ...)
va_list ap; va_list ap;
recursion_check (); recursion_check ();
st_printf ("Fortran runtime error: "); estr_write ("Fortran runtime error: ");
va_start (ap, message); va_start (ap, message);
st_vprintf (message, ap); st_vprintf (message, ap);
va_end (ap); va_end (ap);
st_printf ("\n"); estr_write ("\n");
sys_exit (2); sys_exit (2);
} }
iexport(runtime_error); iexport(runtime_error);
...@@ -267,12 +332,12 @@ runtime_error_at (const char *where, const char *message, ...) ...@@ -267,12 +332,12 @@ runtime_error_at (const char *where, const char *message, ...)
va_list ap; va_list ap;
recursion_check (); recursion_check ();
st_printf ("%s\n", where); estr_write (where);
st_printf ("Fortran runtime error: "); estr_write ("\nFortran runtime error: ");
va_start (ap, message); va_start (ap, message);
st_vprintf (message, ap); st_vprintf (message, ap);
va_end (ap); va_end (ap);
st_printf ("\n"); estr_write ("\n");
sys_exit (2); sys_exit (2);
} }
iexport(runtime_error_at); iexport(runtime_error_at);
...@@ -283,12 +348,12 @@ runtime_warning_at (const char *where, const char *message, ...) ...@@ -283,12 +348,12 @@ runtime_warning_at (const char *where, const char *message, ...)
{ {
va_list ap; va_list ap;
st_printf ("%s\n", where); estr_write (where);
st_printf ("Fortran runtime warning: "); estr_write ("\nFortran runtime warning: ");
va_start (ap, message); va_start (ap, message);
st_vprintf (message, ap); st_vprintf (message, ap);
va_end (ap); va_end (ap);
st_printf ("\n"); estr_write ("\n");
} }
iexport(runtime_warning_at); iexport(runtime_warning_at);
...@@ -301,7 +366,9 @@ internal_error (st_parameter_common *cmp, const char *message) ...@@ -301,7 +366,9 @@ internal_error (st_parameter_common *cmp, const char *message)
{ {
recursion_check (); recursion_check ();
show_locus (cmp); show_locus (cmp);
st_printf ("Internal Error: %s\n", message); estr_write ("Internal Error: ");
estr_write (message);
estr_write ("\n");
/* This function call is here to get the main.o object file included /* This function call is here to get the main.o object file included
when linking statically. This works because error.o is supposed to when linking statically. This works because error.o is supposed to
...@@ -474,7 +541,9 @@ generate_error (st_parameter_common *cmp, int family, const char *message) ...@@ -474,7 +541,9 @@ generate_error (st_parameter_common *cmp, int family, const char *message)
recursion_check (); recursion_check ();
show_locus (cmp); show_locus (cmp);
st_printf ("Fortran runtime error: %s\n", message); estr_write ("Fortran runtime error: ");
estr_write (message);
estr_write ("\n");
sys_exit (2); sys_exit (2);
} }
iexport(generate_error); iexport(generate_error);
...@@ -489,7 +558,9 @@ generate_warning (st_parameter_common *cmp, const char *message) ...@@ -489,7 +558,9 @@ generate_warning (st_parameter_common *cmp, const char *message)
message = " "; message = " ";
show_locus (cmp); show_locus (cmp);
st_printf ("Fortran runtime warning: %s\n", message); estr_write ("Fortran runtime warning: ");
estr_write (message);
estr_write ("\n");
} }
...@@ -532,13 +603,17 @@ notify_std (st_parameter_common *cmp, int std, const char * message) ...@@ -532,13 +603,17 @@ notify_std (st_parameter_common *cmp, int std, const char * message)
{ {
recursion_check (); recursion_check ();
show_locus (cmp); show_locus (cmp);
st_printf ("Fortran runtime error: %s\n", message); estr_write ("Fortran runtime error: ");
estr_write (message);
estr_write ("\n");
sys_exit (2); sys_exit (2);
} }
else else
{ {
show_locus (cmp); show_locus (cmp);
st_printf ("Fortran runtime warning: %s\n", message); estr_write ("Fortran runtime warning: ");
estr_write (message);
estr_write ("\n");
} }
return FAILURE; return FAILURE;
} }
libgfortran/runtime/pause.c
/* Implementation of the STOP statement. /* Implementation of the PAUSE statement.
Copyright 2002, 2005, 2007, 2009, 2010 Free Software Foundation, Inc. Copyright 2002, 2005, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org> Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public modify it under the terms of the GNU General Public
...@@ -25,18 +25,19 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -25,18 +25,19 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h" #include "libgfortran.h"
#include <string.h> #include <string.h>
#include <unistd.h>
static void static void
do_pause (void) do_pause (void)
{ {
char buff[4]; char buff[4];
st_printf ("To resume execution, type go. " estr_write ("To resume execution, type go. "
"Other input will terminate the job.\n"); "Other input will terminate the job.\n");
fgets(buff, 4, stdin); fgets(buff, 4, stdin);
if (strncmp(buff, "go\n", 3) != 0) if (strncmp(buff, "go\n", 3) != 0)
stop_string ('\0', 0); stop_string ('\0', 0);
st_printf ("RESUMED\n"); estr_write ("RESUMED\n");
} }
/* A numeric PAUSE statement. */ /* A numeric PAUSE statement. */
...@@ -59,10 +60,11 @@ export_proto(pause_string); ...@@ -59,10 +60,11 @@ export_proto(pause_string);
void void
pause_string (char *string, GFC_INTEGER_4 len) pause_string (char *string, GFC_INTEGER_4 len)
{ {
st_printf ("PAUSE "); estr_write ("PAUSE ");
while (len--) ssize_t w = write (STDERR_FILENO, string, len);
st_printf ("%c", *(string++)); (void) sizeof (w); /* Avoid compiler warning about not using write
st_printf ("\n"); return val. */
estr_write ("\n");
do_pause (); do_pause ();
} }
libgfortran/runtime/stop.c
/* Implementation of the STOP statement. /* Implementation of the STOP statement.
Copyright 2002, 2005, 2007, 2009, 2010 Free Software Foundation, Inc. Copyright 2002, 2005, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org> Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public modify it under the terms of the GNU General Public
...@@ -25,6 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -25,6 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libgfortran.h" #include "libgfortran.h"
#include <string.h> #include <string.h>
#include <unistd.h>
/* A numeric STOP statement. */ /* A numeric STOP statement. */
...@@ -65,10 +66,10 @@ stop_string (const char *string, GFC_INTEGER_4 len) ...@@ -65,10 +66,10 @@ stop_string (const char *string, GFC_INTEGER_4 len)
{ {
if (string) if (string)
{ {
st_printf ("STOP "); estr_write ("STOP ");
while (len--) ssize_t w = write (STDERR_FILENO, string, len);
st_printf ("%c", *(string++)); (void) sizeof (w); /* Avoid compiler warning about not using w. */
st_printf ("\n"); estr_write ("\n");
} }
sys_exit (0); sys_exit (0);
} }
...@@ -86,10 +87,10 @@ export_proto(error_stop_string); ...@@ -86,10 +87,10 @@ export_proto(error_stop_string);
void void
error_stop_string (const char *string, GFC_INTEGER_4 len) error_stop_string (const char *string, GFC_INTEGER_4 len)
{ {
st_printf ("ERROR STOP "); estr_write ("ERROR STOP ");
while (len--) ssize_t w = write (STDERR_FILENO, string, len);
st_printf ("%c", *(string++)); (void) sizeof (w); /* Avoid compiler warning about not using w. */
st_printf ("\n"); estr_write ("\n");
sys_exit (1); sys_exit (1);
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment