Error printing thread safety, remove GFORTRAN_USE_STDERR
authorJanne Blomqvist <jb@gcc.gnu.org>
Sat, 14 May 2011 07:55:51 +0000 (10:55 +0300)
committerJanne Blomqvist <jb@gcc.gnu.org>
Sat, 14 May 2011 07:55:51 +0000 (10:55 +0300)
From-SVN: r173749

14 files changed:
gcc/fortran/ChangeLog
gcc/fortran/gfortran.texi
libgfortran/ChangeLog
libgfortran/config/fpu-aix.h
libgfortran/config/fpu-generic.h
libgfortran/config/fpu-glibc.h
libgfortran/config/fpu-sysv.h
libgfortran/io/unix.c
libgfortran/libgfortran.h
libgfortran/runtime/backtrace.c
libgfortran/runtime/environ.c
libgfortran/runtime/error.c
libgfortran/runtime/pause.c
libgfortran/runtime/stop.c

index 73a39d910355b4f77948a1ce7cd1340c94ccf2e4..4be4e5db4f4df99cef36c67e5bec11ca295e223b 100644 (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
index 1284c3d20b45fb31a0db30fe8333e7f39c84dd36..c810fe251d6689021684375c9ab7e6045503bc16 100644 (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
 
index ab952172f765fd45b517c81293157bf742aa9c57..8ed0bb6148fbeac0266a00cd713cffd6f045a008 100644 (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
index 7d6f8dfcd7baea8bfe8f2d1118ac819be530225e..262557b6d010a2292393873b8abe2a63858b8fbf 100644 (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);
index 234e6e2cd59063b11982cd59c0e3e959b58d6730..72de91b28c750efb6893423c735830b037797f0b 100644 (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");
 }
index 807f0942e083d815ed0b41e34bc9a302272ac8a2..669b7ad98c132f647f76207297d7cf2894e3a533 100644 (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
 }
index 85ca25285eab254748423bb728614023754c08e9..477008968baff1b303ec50fa3a06a53e88ea525b 100644 (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);
index 4e4bc3b1ee5fa26a492db5b3b52bc2d240416be6..c257766d653db4bb5d323ca86709b3f1a5f65f49 100644 (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. */
index 6cccacadabe9d9e84845c97bfd0beb39fa4ac7a5..ae86a021ee3fd64f82538856ac217e02f3169044 100644 (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);
 
index 5e4f15c78c99a8480f80619bc44f572576ccc69e..aa77025ab749aabad8330019233c4acd90f26429 100644 (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
 }
index a6ce645e0e17a6399f4c5ce6a0b14bcb95418b60..7695f0db198e86ba323f74d24825c5fd5448b668 100644 (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);
 }
index 06c144ae153e2916f50fc9529700573daa5e8206..e61904496c8f802fcd7489100f98fa04171a04ca 100644 (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;
 }
index 61ab4db0343fac3e06ce9f1530398ebb5f190f23..0e3c8ae08fc82d5c0948db13af10259f6dd1eb06 100644 (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 ();
 }
index 29f5031b3af5721bb866d0695a27ce64a52be7af..b6f61ff8bee564b15cb0365b14fc3b92791c89c1 100644 (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);
 }