aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/runtime
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/runtime')
-rw-r--r--libgfortran/runtime/backtrace.c38
-rw-r--r--libgfortran/runtime/environ.c38
-rw-r--r--libgfortran/runtime/error.c111
-rw-r--r--libgfortran/runtime/pause.c22
-rw-r--r--libgfortran/runtime/stop.c21
5 files changed, 161 insertions, 69 deletions
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index 5e4f15c..aa77025 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -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
}
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index a6ce645..7695f0d 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -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);
}
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 06c144a..e619044 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -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;
}
diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
index 61ab4db..0e3c8ae 100644
--- a/libgfortran/runtime/pause.c
+++ b/libgfortran/runtime/pause.c
@@ -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 ();
}
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 29f5031..b6f61ff 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -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);
}
generated by cgit v1.1 at 2025-05-31 04:04:56 +0000