@@ -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
@@ -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);
@@ -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");
}
@@ -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
}
@@ -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);
@@ -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. */
@@ -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);
@@ -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
}
@@ -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);
}
@@ -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;
}
@@ -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 ();
}
@@ -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);
}