Use vectored writes when reporting errors and warnings.

When producing error and warning messages, libgfortran writes a
message by using many system calls.  By using vectored writes (the
POSIX writev function) when available and feasible to use without
major surgery, we reduce the chance that output gets intermingled with
other output to stderr.

In practice, this is done by introducing a new function estr_writev in
addition to the existing estr_write.  In order to use this, the old
st_vprintf is removed, replaced by direct calls of vsnprintf, allowing
more message batching.

Regtested on x86_64-pc-linux-gnu.

libgfortran/ChangeLog:

2018-09-21  Janne Blomqvist  <jb@gcc.gnu.org>

	* config.h.in: Regenerated.
	* configure: Regenerated.
	* configure.ac: Check for writev and sys/uio.h.
	* libgfortran.h: Include sys/uio.h.
	(st_vprintf): Remove prototype.
	(struct iovec): Define if not available.
	(estr_writev): New prototype.
	* runtime/backtrace.c (error_callback): Use estr_writev.
	* runtime/error.c (ST_VPRINTF_SIZE): Remove.
	(estr_writev): New function.
	(st_vprintf): Remove.
	(gf_vsnprintf): New function.
	(ST_ERRBUF_SIZE): New macro.
	(st_printf): Use vsnprintf.
	(os_error): Use estr_writev.
	(runtime_error): Use vsnprintf and estr_writev.
	(runtime_error_at): Likewise.
	(runtime_warning_at): Likewise.
	(internal_error): Use estr_writev.
	(generate_error_common): Likewise.
	(generate_warning): Likewise.
	(notify_std): Likewise.
	* runtime/pause.c (pause_string): Likewise.
	* runtime/stop.c (report_exception): Likewise.
	(stop_string): Likewise.
	(error_stop_string): Likewise.

From-SVN: r264487

4 files changed, 221 insertions, 79 deletions

diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
index b824688..e0c2770 100644
--- a/libgfortran/runtime/backtrace.c
+++ b/libgfortran/runtime/backtrace.c
@@ -68,6 +68,7 @@ static void
 error_callback (void *data, const char *msg, int errnum)
 {
   struct mystate *state = (struct mystate *) data;
+  struct iovec iov[5];
 #define ERRHDR "\nCould not print backtrace: "
 
   if (errnum < 0)
@@ -77,21 +78,31 @@ error_callback (void *data, const char *msg, int errnum)
     }
   else if (errnum == 0)
     {
-      estr_write (ERRHDR);
-      estr_write (msg);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) ERRHDR;
+      iov[0].iov_len = strlen (ERRHDR);
+      iov[1].iov_base = (char*) msg;
+      iov[1].iov_len = strlen (msg);
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
     }
   else
     {
       char errbuf[256];
       if (state->in_signal_handler)
 	{
-	  estr_write (ERRHDR);
-	  estr_write (msg);
-	  estr_write (", errno: ");
+	  iov[0].iov_base = (char*) ERRHDR;
+	  iov[0].iov_len = strlen (ERRHDR);
+	  iov[1].iov_base = (char*) msg;
+	  iov[1].iov_len = strlen (msg);
+	  iov[2].iov_base = (char*) ", errno: ";
+	  iov[2].iov_len = strlen (iov[2].iov_base);
 	  const char *p = gfc_itoa (errnum, errbuf, sizeof (errbuf));
-	  estr_write (p);
-	  estr_write ("\n");
+	  iov[3].iov_base = (char*) p;
+	  iov[3].iov_len = strlen (p);
+	  iov[4].iov_base = (char*) "\n";
+	  iov[4].iov_len = 1;
+	  estr_writev (iov, 5);
 	}
       else
 	st_printf (ERRHDR "%s: %s\n", msg,
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 1e8b622..b07a4c0 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -114,52 +114,71 @@ estr_write (const char *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.  */
+/* Write a vector of strings to standard error.  This function is
+   async-signal-safe.  */
 
-#define ST_VPRINTF_SIZE 512
+ssize_t
+estr_writev (const struct iovec *iov, int iovcnt)
+{
+#ifdef HAVE_WRITEV
+  return writev (STDERR_FILENO, iov, iovcnt);
+#else
+  ssize_t w = 0;
+  for (int i = 0; i < iovcnt; i++)
+    {
+      ssize_t r = write (STDERR_FILENO, iov[i].iov_base, iov[i].iov_len);
+      if (r == -1)
+	return r;
+      w += r;
+    }
+  return w;
+#endif
+}
 
-int
-st_vprintf (const char *format, va_list ap)
+
+#ifndef HAVE_VSNPRINTF
+static int
+gf_vsnprintf (char *str, size_t size, 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)
+  if (written >= 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));
+#define ERROR_MESSAGE "Internal error: buffer overrun in gf_vsnprintf()\n"
+      write (STDERR_FILENO, buffer, size - 1);
+      write (STDERR_FILENO, ERROR_MESSAGE, strlen (ERROR_MESSAGE));
       sys_abort ();
 #undef ERROR_MESSAGE
 
     }
-#endif
-
-  written = write (STDERR_FILENO, buffer, written);
   return written;
 }
 
+#define vsnprintf gf_vsnprintf
+#endif
+
+
+/* printf() like function for for printing to stderr.  Uses a stack
+   allocated buffer and doesn't lock stderr, so it should be safe to
+   use from within a signal handler.  */
+
+#define ST_ERRBUF_SIZE 512
 
 int
 st_printf (const char * format, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
   int written;
   va_list ap;
   va_start (ap, format);
-  written = st_vprintf (format, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, format, ap);
   va_end (ap);
+  written = write (STDERR_FILENO, buffer, written);
   return written;
 }
 
@@ -340,12 +359,19 @@ void
 os_error (const char *message)
 {
   char errmsg[STRERR_MAXSZ];
+  struct iovec iov[5];
   recursion_check ();
-  estr_write ("Operating system error: ");
-  estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ));
-  estr_write ("\n");
-  estr_write (message);
-  estr_write ("\n");
+  iov[0].iov_base = (char*) "Operating system error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = gf_strerror (errno, errmsg, STRERR_MAXSZ);
+  iov[1].iov_len = strlen (iov[1].iov_base);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  iov[3].iov_base = (char*) message;
+  iov[3].iov_len = strlen (message);
+  iov[4].iov_base = (char*) "\n";
+  iov[4].iov_len = 1;
+  estr_writev (iov, 5);
   exit_error (1);
 }
 iexport(os_error);
@@ -357,14 +383,25 @@ iexport(os_error);
 void
 runtime_error (const char *message, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
+  struct iovec iov[3];
   va_list ap;
+  int written;
 
   recursion_check ();
-  estr_write ("Fortran runtime error: ");
+  iov[0].iov_base = (char*) "Fortran runtime error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
   va_start (ap, message);
-  st_vprintf (message, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
   va_end (ap);
-  estr_write ("\n");
+  if (written >= 0)
+    {
+      iov[1].iov_base = buffer;
+      iov[1].iov_len = written;
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
+    }
   exit_error (2);
 }
 iexport(runtime_error);
@@ -375,15 +412,27 @@ iexport(runtime_error);
 void
 runtime_error_at (const char *where, const char *message, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
   va_list ap;
+  struct iovec iov[4];
+  int written;
 
   recursion_check ();
-  estr_write (where);
-  estr_write ("\nFortran runtime error: ");
+  iov[0].iov_base = (char*) where;
+  iov[0].iov_len = strlen (where);
+  iov[1].iov_base = (char*) "\nFortran runtime error: ";
+  iov[1].iov_len = strlen (iov[1].iov_base);
   va_start (ap, message);
-  st_vprintf (message, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
   va_end (ap);
-  estr_write ("\n");
+  if (written >= 0)
+    {
+      iov[2].iov_base = buffer;
+      iov[2].iov_len = written;
+      iov[3].iov_base = (char*) "\n";
+      iov[3].iov_len = 1;
+      estr_writev (iov, 4);
+    }
   exit_error (2);
 }
 iexport(runtime_error_at);
@@ -392,14 +441,26 @@ iexport(runtime_error_at);
 void
 runtime_warning_at (const char *where, const char *message, ...)
 {
+  char buffer[ST_ERRBUF_SIZE];
   va_list ap;
+  struct iovec iov[4];
+  int written;
 
-  estr_write (where);
-  estr_write ("\nFortran runtime warning: ");
+  iov[0].iov_base = (char*) where;
+  iov[0].iov_len = strlen (where);
+  iov[1].iov_base = (char*) "\nFortran runtime warning: ";
+  iov[1].iov_len = strlen (iov[1].iov_base);
   va_start (ap, message);
-  st_vprintf (message, ap);
+  written = vsnprintf (buffer, ST_ERRBUF_SIZE, message, ap);
   va_end (ap);
-  estr_write ("\n");
+  if (written >= 0)
+    {
+      iov[2].iov_base = buffer;
+      iov[2].iov_len = written;
+      iov[3].iov_base = (char*) "\n";
+      iov[3].iov_len = 1;
+      estr_writev (iov, 4);
+    }
 }
 iexport(runtime_warning_at);
 
@@ -410,11 +471,17 @@ iexport(runtime_warning_at);
 void
 internal_error (st_parameter_common *cmp, const char *message)
 {
+  struct iovec iov[3];
+
   recursion_check ();
   show_locus (cmp);
-  estr_write ("Internal Error: ");
-  estr_write (message);
-  estr_write ("\n");
+  iov[0].iov_base = (char*) "Internal Error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = (char*) message;
+  iov[1].iov_len = strlen (message);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
 
   /* This function call is here to get the main.o object file included
      when linking statically. This works because error.o is supposed to
@@ -609,9 +676,14 @@ generate_error_common (st_parameter_common *cmp, int family, const char *message
 
   recursion_check ();
   show_locus (cmp);
-  estr_write ("Fortran runtime error: ");
-  estr_write (message);
-  estr_write ("\n");
+  struct iovec iov[3];
+  iov[0].iov_base = (char*) "Fortran runtime error: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = (char*) message;
+  iov[1].iov_len = strlen (message);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
   return false;
 }
 
@@ -645,9 +717,14 @@ generate_warning (st_parameter_common *cmp, const char *message)
     message = " ";
 
   show_locus (cmp);
-  estr_write ("Fortran runtime warning: ");
-  estr_write (message);
-  estr_write ("\n");
+  struct iovec iov[3];
+  iov[0].iov_base = (char*) "Fortran runtime warning: ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = (char*) message;
+  iov[1].iov_len = strlen (message);
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
 }
 
 
@@ -678,6 +755,7 @@ bool
 notify_std (st_parameter_common *cmp, int std, const char * message)
 {
   int warning;
+  struct iovec iov[3];
 
   if (!compile_options.pedantic)
     return true;
@@ -690,17 +768,25 @@ notify_std (st_parameter_common *cmp, int std, const char * message)
     {
       recursion_check ();
       show_locus (cmp);
-      estr_write ("Fortran runtime error: ");
-      estr_write (message);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) "Fortran runtime error: ";
+      iov[0].iov_len = strlen (iov[0].iov_base);
+      iov[1].iov_base = (char*) message;
+      iov[1].iov_len = strlen (message);
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
       exit_error (2);
     }
   else
     {
       show_locus (cmp);
-      estr_write ("Fortran runtime warning: ");
-      estr_write (message);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) "Fortran runtime warning: ";
+      iov[0].iov_len = strlen (iov[0].iov_base);
+      iov[1].iov_base = (char*) message;
+      iov[1].iov_len = strlen (message);
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
     }
   return false;
 }
diff --git a/libgfortran/runtime/pause.c b/libgfortran/runtime/pause.c
index 37672d4..12997c7 100644
--- a/libgfortran/runtime/pause.c
+++ b/libgfortran/runtime/pause.c
@@ -64,11 +64,15 @@ export_proto(pause_string);
 void
 pause_string (char *string, size_t len)
 {
-  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");
+  struct iovec iov[3];
+
+  iov[0].iov_base = (char*) "PAUSE ";
+  iov[0].iov_len = strlen (iov[0].iov_base);
+  iov[1].iov_base = string;
+  iov[1].iov_len = len;
+  iov[2].iov_base = (char*) "\n";
+  iov[2].iov_len = 1;
+  estr_writev (iov, 3);
 
   do_pause ();
 }
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 1e6dd8c..4833e7b 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -29,6 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <unistd.h>
 #endif
 
+#include <string.h>
 
 /* Fortran 2008 demands: If any exception (14) is signaling on that image, the
    processor shall issue a warning indicating which exceptions are signaling;
@@ -40,7 +41,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 static void
 report_exception (void)
 {
-  int set_excepts;
+  struct iovec iov[8];
+  int set_excepts, iovcnt = 1;
 
   if (!compile_options.fpe_summary)
     return;
@@ -49,33 +51,62 @@ report_exception (void)
   if ((set_excepts & compile_options.fpe_summary) == 0)
     return;
 
-  estr_write ("Note: The following floating-point exceptions are signalling:");
+  iov[0].iov_base = (char*) "Note: The following floating-point exceptions are signalling:";
+  iov[0].iov_len = strlen (iov[0].iov_base);
 
   if ((compile_options.fpe_summary & GFC_FPE_INVALID)
       && (set_excepts & GFC_FPE_INVALID))
-    estr_write (" IEEE_INVALID_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_INVALID_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_ZERO)
       && (set_excepts & GFC_FPE_ZERO))
-    estr_write (" IEEE_DIVIDE_BY_ZERO");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_DIVIDE_BY_ZERO";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_OVERFLOW)
       && (set_excepts & GFC_FPE_OVERFLOW))
-    estr_write (" IEEE_OVERFLOW_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_OVERFLOW_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_UNDERFLOW)
       && (set_excepts & GFC_FPE_UNDERFLOW))
-    estr_write (" IEEE_UNDERFLOW_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_UNDERFLOW_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_DENORMAL)
       && (set_excepts & GFC_FPE_DENORMAL))
-    estr_write (" IEEE_DENORMAL");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_DENORMAL";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
 
   if ((compile_options.fpe_summary & GFC_FPE_INEXACT)
       && (set_excepts & GFC_FPE_INEXACT))
-    estr_write (" IEEE_INEXACT_FLAG");
+    {
+      iov[iovcnt].iov_base = (char*) " IEEE_INEXACT_FLAG";
+      iov[iovcnt].iov_len = strlen (iov[iovcnt].iov_base);
+      iovcnt++;
+    }
+
+  iov[iovcnt].iov_base = (char*) "\n";
+  iov[iovcnt].iov_len = 1;
+  iovcnt++;
 
-  estr_write ("\n");
+  estr_writev (iov, iovcnt);
 }
 
 
@@ -106,9 +137,14 @@ stop_string (const char *string, size_t len, bool quiet)
       report_exception ();
       if (string)
 	{
-	  estr_write ("STOP ");
-	  (void) write (STDERR_FILENO, string, len);
-	  estr_write ("\n");
+	  struct iovec iov[3];
+	  iov[0].iov_base = (char*) "STOP ";
+	  iov[0].iov_len = strlen (iov[0].iov_base);
+	  iov[1].iov_base = (char*) string;
+	  iov[1].iov_len = len;
+	  iov[2].iov_base = (char*) "\n";
+	  iov[2].iov_len = 1;
+	  estr_writev (iov, 3);
 	}
     }
   exit (0);
@@ -128,10 +164,15 @@ error_stop_string (const char *string, size_t len, bool quiet)
 {
   if (!quiet)
     {
+      struct iovec iov[3];
       report_exception ();
-      estr_write ("ERROR STOP ");
-      (void) write (STDERR_FILENO, string, len);
-      estr_write ("\n");
+      iov[0].iov_base = (char*) "ERROR STOP ";
+      iov[0].iov_len = strlen (iov[0].iov_base);
+      iov[1].iov_base = (char*) string;
+      iov[1].iov_len = len;
+      iov[2].iov_base = (char*) "\n";
+      iov[2].iov_len = 1;
+      estr_writev (iov, 3);
     }
   exit_error (1);
 }