+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
* 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.
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
+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
/* 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
#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);
/* 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
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");
}
/* 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
#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. */
#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
}
/* 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
#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);
}
-/* 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. */
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;
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);
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);
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);
}
if (fgets (func, sizeof(func), output))
{
- st_printf ("\nBacktrace for this error:\n");
+ estr_write ("\nBacktrace for this error:\n");
do
{
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;
}
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);
}
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);
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;
#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);
#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
}
buffer[i] = '\0';
- st_printf (buffer);
+ estr_write (buffer);
}
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");
}
"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},
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)
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);
}
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
#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
}
* 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 *
void
show_locus (st_parameter_common *cmp)
{
- static char *filename;
+ char *filename;
if (!options.locus || cmp == NULL || cmp->filename == NULL)
return;
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",
{
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);
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);
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);
{
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);
{
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
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);
message = " ";
show_locus (cmp);
- st_printf ("Fortran runtime warning: %s\n", message);
+ estr_write ("Fortran runtime warning: ");
+ estr_write (message);
+ estr_write ("\n");
}
{
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;
}
-/* 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
#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. */
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 ();
}
/* 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
#include "libgfortran.h"
#include <string.h>
+#include <unistd.h>
/* A numeric STOP statement. */
{
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);
}
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);
}
OSDN Git Service
