OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Error printing thread safety, remove GFORTRAN_USE_STDERR

Browse Source 
From-SVN: r173749
This commit is contained in:
Janne Blomqvist 2011-05-14 10:55:51 +03:00
parent b4224aec54
commit 1028b2bded
14 changed files with 267 additions and 197 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/fortran/ChangeLog
View File

@ -1,3 +1,7 @@
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>
PR fortran/48972

9
gcc/fortran/gfortran.texi
View File

@ -579,7 +579,6 @@ Malformed environment variables are silently ignored.
* GFORTRAN_STDIN_UNIT:: Unit number for standard input
* GFORTRAN_STDOUT_UNIT:: Unit number for standard output
* GFORTRAN_STDERR_UNIT:: Unit number for standard error
* GFORTRAN_USE_STDERR:: Send library output to standard error
* GFORTRAN_TMPDIR:: Directory for scratch files
* GFORTRAN_UNBUFFERED_ALL:: Don't buffer I/O for all 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
preconnected to standard error. This must be a positive integer.
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
@section @env{GFORTRAN_TMPDIR}---Directory for scratch files

35
libgfortran/ChangeLog
View File

@ -1,3 +1,38 @@
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>
PR fortran/48961

28
libgfortran/config/fpu-aix.h
View File

@ -1,8 +1,8 @@
/* 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>
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
modify it under the terms of the GNU General Public
@ -38,44 +38,44 @@ set_fpu (void)
#ifdef TRP_INVALID
mode |= TRP_INVALID;
#else
st_printf ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_DENORMAL)
st_printf ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
if (options.fpe & GFC_FPE_ZERO)
#ifdef TRP_DIV_BY_ZERO
mode |= TRP_DIV_BY_ZERO;
#else
st_printf ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_OVERFLOW)
#ifdef TRP_OVERFLOW
mode |= TRP_OVERFLOW;
#else
st_printf ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_UNDERFLOW)
#ifdef TRP_UNDERFLOW
mode |= TRP_UNDERFLOW;
#else
st_printf ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_PRECISION)
#ifdef TRP_UNDERFLOW
mode |= TRP_UNDERFLOW;
#else
st_printf ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
#endif
fp_trap(FP_TRAP_SYNC);

28
libgfortran/config/fpu-generic.h
View File

@ -1,8 +1,8 @@
/* 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>
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
modify it under the terms of the GNU General Public
@ -32,21 +32,21 @@ void
set_fpu (void)
{
if (options.fpe & GFC_FPE_INVALID)
st_printf ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
if (options.fpe & GFC_FPE_DENORMAL)
st_printf ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
if (options.fpe & GFC_FPE_ZERO)
st_printf ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
if (options.fpe & GFC_FPE_OVERFLOW)
st_printf ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
if (options.fpe & GFC_FPE_UNDERFLOW)
st_printf ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
if (options.fpe & GFC_FPE_PRECISION)
st_printf ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
}

28
libgfortran/config/fpu-glibc.h
View File

@ -1,8 +1,8 @@
/* 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>
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
modify it under the terms of the GNU General Public
@ -40,8 +40,8 @@ void set_fpu (void)
#ifdef FE_INVALID
feenableexcept (FE_INVALID);
#else
st_printf ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
#endif
/* glibc does never have a FE_DENORMAL. */
@ -49,39 +49,39 @@ void set_fpu (void)
#ifdef FE_DENORMAL
feenableexcept (FE_DENORMAL);
#else
st_printf ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_ZERO)
#ifdef FE_DIVBYZERO
feenableexcept (FE_DIVBYZERO);
#else
st_printf ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_OVERFLOW)
#ifdef FE_OVERFLOW
feenableexcept (FE_OVERFLOW);
#else
st_printf ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_UNDERFLOW)
#ifdef FE_UNDERFLOW
feenableexcept (FE_UNDERFLOW);
#else
st_printf ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_PRECISION)
#ifdef FE_INEXACT
feenableexcept (FE_INEXACT);
#else
st_printf ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
#endif
}

28
libgfortran/config/fpu-sysv.h
View File

@ -1,8 +1,8 @@
/* 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>
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
modify it under the terms of the GNU General Public
@ -34,48 +34,48 @@ set_fpu (void)
#ifdef FP_X_INV
cw |= FP_X_INV;
#else
st_printf ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'invalid operation' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_DENORMAL)
#ifdef FP_X_DNML
cw |= FP_X_DNML;
#else
st_printf ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'denormal number' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_ZERO)
#ifdef FP_X_DZ
cw |= FP_X_DZ;
#else
st_printf ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'division by zero' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_OVERFLOW)
#ifdef FP_X_OFL
cw |= FP_X_OFL;
#else
st_printf ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'overflow' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_UNDERFLOW)
#ifdef FP_X_UFL
cw |= FP_X_UFL;
#else
st_printf ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'underflow' "
"exception not supported.\n");
#endif
if (options.fpe & GFC_FPE_PRECISION)
#ifdef FP_X_IMP
cw |= FP_X_IMP;
#else
st_printf ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
estr_write ("Fortran runtime warning: IEEE 'loss of precision' "
"exception not supported.\n");
#endif
fpsetmask(cw);

55
libgfortran/io/unix.c
View File

@ -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
* that is a filename, figure out if the file is the same as the
* filename. */

19
libgfortran/libgfortran.h
View File

@ -508,7 +508,7 @@ typedef struct
int separator_len;
const char *separator;
int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl;
int all_unbuffered, unbuffered_preconnected, default_recl;
int fpe, dump_core, backtrace;
}
options_t;
@ -691,6 +691,16 @@ internal_proto(show_backtrace);
extern void sys_exit (int) __attribute__ ((noreturn));
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);
internal_proto(gfc_xtoa);
@ -792,13 +802,6 @@ internal_proto(close_units);
extern int unit_to_fd (int);
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);
internal_proto(filename_from_unit);

38
libgfortran/runtime/backtrace.c
View File

@ -95,7 +95,11 @@ dump_glibc_backtrace (int depth, char *str[])
int i;
for (i = 0; i < depth; i++)
st_printf (" + %s\n", str[i]);
{
estr_write (" + ");
estr_write (str[i]);
estr_write ("\n");
}
free (str);
}
@ -192,7 +196,7 @@ show_backtrace (void)
if (fgets (func, sizeof(func), output))
{
st_printf ("\nBacktrace for this error:\n");
estr_write ("\nBacktrace for this error:\n");
do
{
@ -222,7 +226,9 @@ show_backtrace (void)
if (func[0] == '?' && func[1] == '?' && file[0] == '?'
&& file[1] == '?')
{
st_printf (" + %s\n", str[i]);
estr_write (" + ");
estr_write (str[i]);
estr_write ("\n");
continue;
}
@ -239,15 +245,25 @@ show_backtrace (void)
line = -1;
if (strcmp (func, "MAIN__") == 0)
st_printf (" + in the main program\n");
estr_write (" + in the main program\n");
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)
continue;
if (line <= 0)
st_printf (" from file %s\n", file);
{
estr_write (" from file ");
estr_write (file);
estr_write ("\n");
}
else
st_printf (" at line %d of file %s\n", line, file);
}
@ -257,8 +273,8 @@ show_backtrace (void)
return;
fallback:
st_printf ("** Something went wrong while running addr2line. **\n"
"** Falling back to a simpler backtrace scheme. **\n");
estr_write ("** Something went wrong while running addr2line. **\n"
"** Falling back to a simpler backtrace scheme. **\n");
}
}
while (0);
@ -288,7 +304,7 @@ fallback:
char *arg[NUM_ARGS+1];
char buf[20];
st_printf ("\nBacktrace for this error:\n");
estr_write ("\nBacktrace for this error:\n");
arg[0] = (char *) "pstack";
snprintf (buf, sizeof(buf), "%d", (int) getppid ());
arg[1] = buf;
@ -301,7 +317,7 @@ fallback:
#if GLIBC_BACKTRACE
dump_glibc_backtrace (depth, str);
#else
st_printf (" unable to produce a backtrace, sorry!\n");
estr_write (" unable to produce a backtrace, sorry!\n");
#endif
_exit (0);
@ -316,7 +332,7 @@ fallback:
#if 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);
#endif
}

38
libgfortran/runtime/environ.c
View File

@ -71,7 +71,7 @@ print_spaces (int n)
buffer[i] = '\0';
st_printf (buffer);
estr_write (buffer);
}
@ -261,7 +261,10 @@ show_string (variable * v)
if (p == NULL)
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[] = {
"Unit number that will be preconnected to standard error\n"
"(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,
"Directory for scratch files. Overrides the TMP environment variable\n"
"If TMP is not set " DEFAULT_TEMPDIR " is used.", 0},
@ -352,32 +351,33 @@ show_variables (void)
int n;
/* TODO: print version number. */
st_printf ("GNU Fortran 95 runtime library version "
estr_write ("GNU Fortran runtime library version "
"UNKNOWN" "\n\n");
st_printf ("Environment variables:\n");
st_printf ("----------------------\n");
estr_write ("Environment variables:\n");
estr_write ("----------------------\n");
for (v = variable_table; v->name; v++)
{
n = st_printf ("%s", v->name);
n = estr_write (v->name);
print_spaces (25 - n);
if (v->show == show_integer)
st_printf ("Integer ");
estr_write ("Integer ");
else if (v->show == show_boolean)
st_printf ("Boolean ");
estr_write ("Boolean ");
else
st_printf ("String ");
estr_write ("String ");
v->show (v);
st_printf ("%s\n\n", v->desc);
estr_write (v->desc);
estr_write ("\n\n");
}
/* System error codes */
st_printf ("\nRuntime error codes:");
st_printf ("\n--------------------\n");
estr_write ("\nRuntime error codes:");
estr_write ("\n--------------------\n");
for (n = LIBERROR_FIRST + 1; n < LIBERROR_LAST; n++)
if (n < 0 || n > 9)
@ -385,10 +385,8 @@ show_variables (void)
else
st_printf (" %d %s\n", n, translate_error (n));
st_printf ("\nCommand line arguments:\n");
st_printf (" --help Print this list\n");
/* st_printf(" --resume <dropfile> Resume program execution from dropfile\n"); */
estr_write ("\nCommand line arguments:\n");
estr_write (" --help Print this list\n");
sys_exit (0);
}

111
libgfortran/runtime/error.c
View File

@ -81,7 +81,7 @@ sys_exit (int code)
struct rlimit core_limit;
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");
#endif
@ -89,7 +89,7 @@ sys_exit (int code)
#if defined(HAVE_KILL) && defined(HAVE_GETPID) && defined(SIGQUIT)
kill (getpid (), SIGQUIT);
#else
st_printf ("Core dump not possible, sorry.");
estr_write ("Core dump not possible, sorry.");
#endif
}
@ -112,6 +112,67 @@ sys_exit (int 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. */
const char *
@ -177,7 +238,7 @@ gf_strerror (int errnum,
void
show_locus (st_parameter_common *cmp)
{
static char *filename;
char *filename;
if (!options.locus || cmp == NULL || cmp->filename == NULL)
return;
@ -185,6 +246,7 @@ show_locus (st_parameter_common *cmp)
if (cmp->unit > 0)
{
filename = filename_from_unit (cmp->unit);
if (filename != NULL)
{
st_printf ("At line %d of file %s (unit = %d, file = '%s')\n",
@ -233,8 +295,11 @@ os_error (const char *message)
{
char errmsg[STRERR_MAXSZ];
recursion_check ();
st_printf ("Operating system error: %s\n%s\n",
gf_strerror (errno, errmsg, STRERR_MAXSZ), message);
estr_write ("Operating system error: ");
estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ));
estr_write ("\n");
estr_write (message);
estr_write ("\n");
sys_exit (1);
}
iexport(os_error);
@ -249,11 +314,11 @@ runtime_error (const char *message, ...)
va_list ap;
recursion_check ();
st_printf ("Fortran runtime error: ");
estr_write ("Fortran runtime error: ");
va_start (ap, message);
st_vprintf (message, ap);
va_end (ap);
st_printf ("\n");
estr_write ("\n");
sys_exit (2);
}
iexport(runtime_error);
@ -267,12 +332,12 @@ runtime_error_at (const char *where, const char *message, ...)
va_list ap;
recursion_check ();
st_printf ("%s\n", where);
st_printf ("Fortran runtime error: ");
estr_write (where);
estr_write ("\nFortran runtime error: ");
va_start (ap, message);
st_vprintf (message, ap);
va_end (ap);
st_printf ("\n");
estr_write ("\n");
sys_exit (2);
}
iexport(runtime_error_at);
@ -283,12 +348,12 @@ runtime_warning_at (const char *where, const char *message, ...)
{
va_list ap;
st_printf ("%s\n", where);
st_printf ("Fortran runtime warning: ");
estr_write (where);
estr_write ("\nFortran runtime warning: ");
va_start (ap, message);
st_vprintf (message, ap);
va_end (ap);
st_printf ("\n");
estr_write ("\n");
}
iexport(runtime_warning_at);
@ -301,7 +366,9 @@ internal_error (st_parameter_common *cmp, const char *message)
{
recursion_check ();
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
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)
recursion_check ();
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);
}
iexport(generate_error);
@ -489,7 +558,9 @@ generate_warning (st_parameter_common *cmp, const char *message)
message = " ";
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)
{
recursion_check ();
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);
}
else
{
show_locus (cmp);
st_printf ("Fortran runtime warning: %s\n", message);
estr_write ("Fortran runtime warning: ");
estr_write (message);
estr_write ("\n");
}
return FAILURE;
}

22
libgfortran/runtime/pause.c
View File

@ -1,8 +1,8 @@
/* Implementation of the STOP statement.
Copyright 2002, 2005, 2007, 2009, 2010 Free Software Foundation, Inc.
/* Implementation of the PAUSE statement.
Copyright 2002, 2005, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
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
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
#include "libgfortran.h"
#include <string.h>
#include <unistd.h>
static void
do_pause (void)
{
char buff[4];
st_printf ("To resume execution, type go. "
"Other input will terminate the job.\n");
estr_write ("To resume execution, type go. "
"Other input will terminate the job.\n");
fgets(buff, 4, stdin);
if (strncmp(buff, "go\n", 3) != 0)
stop_string ('\0', 0);
st_printf ("RESUMED\n");
estr_write ("RESUMED\n");
}
/* A numeric PAUSE statement. */
@ -59,10 +60,11 @@ export_proto(pause_string);
void
pause_string (char *string, GFC_INTEGER_4 len)
{
st_printf ("PAUSE ");
while (len--)
st_printf ("%c", *(string++));
st_printf ("\n");
estr_write ("PAUSE ");
ssize_t w = write (STDERR_FILENO, string, len);
(void) sizeof (w); /* Avoid compiler warning about not using write
return val. */
estr_write ("\n");
do_pause ();
}

21
libgfortran/runtime/stop.c
View File

@ -1,8 +1,8 @@
/* 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>
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
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
#include "libgfortran.h"
#include <string.h>
#include <unistd.h>
/* A numeric STOP statement. */
@ -65,10 +66,10 @@ stop_string (const char *string, GFC_INTEGER_4 len)
{
if (string)
{
st_printf ("STOP ");
while (len--)
st_printf ("%c", *(string++));
st_printf ("\n");
estr_write ("STOP ");
ssize_t w = write (STDERR_FILENO, string, len);
(void) sizeof (w); /* Avoid compiler warning about not using w. */
estr_write ("\n");
}
sys_exit (0);
}
@ -86,10 +87,10 @@ export_proto(error_stop_string);
void
error_stop_string (const char *string, GFC_INTEGER_4 len)
{
st_printf ("ERROR STOP ");
while (len--)
st_printf ("%c", *(string++));
st_printf ("\n");
estr_write ("ERROR STOP ");
ssize_t w = write (STDERR_FILENO, string, len);
(void) sizeof (w); /* Avoid compiler warning about not using w. */
estr_write ("\n");
sys_exit (1);
}