PR 47007 and 61847 Locale failures in libgfortran.

2014-11-10  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/47007
	PR libfortran/61847
	* config.h.in: Regenerated.
	* configure: Regenerated.
	* configure.ac (AC_CHECK_HEADERS_ONCE): Check for xlocale.h.
	(AC_CHECK_FUNCS_ONCE): Check for newlocale, freelocale, uselocale,
	strerror_l.
	* io/io.h (locale.h): Include.
	(xlocale.h): Include if present.
	(c_locale): New variable.
	(old_locale): New variable.
	(old_locale_ctr): New variable.
	(old_locale_lock): New variable.
	(st_parameter_dt): Add old_locale member.
	* io/transfer.c (data_transfer_init): Set locale to "C" if doing
	formatted transfer.
	(finalize_transfer): Reset locale to previous.
	* io/unit.c (c_locale): New variable.
	(old_locale): New variable.
	(old_locale_ctr): New variable.
	(old_locale_lock): New variable.
	(init_units): Init c_locale, init old_locale_lock.
	(close_units): Free c_locale.
	* runtime/error.c (locale.h): Include.
	(xlocale.h): Include if present.
	(gf_strerror): Use strerror_l if available. Reset locale to
	LC_GLOBAL_LOCALE for strerror_r branch.

2014-11-10  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/47007
	PR libfortran/61847
	* gfortran.texi: Add note about locale issues to thread-safety
	section.

From-SVN: r217273

3 files changed, 102 insertions, 12 deletions

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 1e0d092..a75177f 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -32,6 +32,17 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #include <gthr.h>
 
+
+/* POSIX 2008 specifies that the extended locale stuff is found in
+   locale.h, but some systems have them in xlocale.h.  */
+
+#include <locale.h>
+
+#ifdef HAVE_XLOCALE_H
+#include <xlocale.h>
+#endif
+
+
 /* Forward declarations.  */
 struct st_parameter_dt;
 typedef struct stream stream;
@@ -40,6 +51,19 @@ struct format_data;
 typedef struct fnode fnode;
 struct gfc_unit;
 
+#ifdef HAVE_NEWLOCALE
+/* We have POSIX 2008 extended locale stuff.  */
+extern locale_t c_locale;
+internal_proto(c_locale);
+#else
+extern char* old_locale;
+internal_proto(old_locale);
+extern int old_locale_ctr;
+internal_proto(old_locale_ctr);
+extern __gthread_mutex_t old_locale_lock;
+internal_proto(old_locale_lock);
+#endif
+
 
 /* Macros for testing what kinds of I/O we are doing.  */
 
@@ -450,6 +474,9 @@ typedef struct st_parameter_dt
 	  char *line_buffer;
 	  struct format_data *fmt;
 	  namelist_info *ionml;
+#ifdef HAVE_NEWLOCALE
+	  locale_t old_locale;
+#endif
 	  /* Current position within the look-ahead line buffer.  */
 	  int line_buffer_pos;
 	  /* Storage area for values except for strings.  Must be
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index dc1b6f4..87b8c05 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2870,13 +2870,27 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	dtp->u.p.current_unit->read_bad = 1;
     }
 
-  /* Start the data transfer if we are doing a formatted transfer.  */
-  if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED
-      && ((cf & (IOPARM_DT_LIST_FORMAT | IOPARM_DT_HAS_NAMELIST_NAME)) == 0)
-      && dtp->u.p.ionml == NULL)
-    formatted_transfer (dtp, 0, NULL, 0, 0, 1);
+  if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED)
+    {
+#ifdef HAVE_USELOCALE
+      dtp->u.p.old_locale = uselocale (c_locale);
+#else
+      __gthread_mutex_lock (&old_locale_lock);
+      if (!old_locale_ctr++)
+	{
+	  old_locale = setlocale (LC_NUMERIC, NULL);
+	  setlocale (LC_NUMERIC, "C");
+	}
+      __gthread_mutex_unlock (&old_locale_lock);
+#endif
+      /* Start the data transfer if we are doing a formatted transfer.  */
+      if ((cf & (IOPARM_DT_LIST_FORMAT | IOPARM_DT_HAS_NAMELIST_NAME)) == 0
+	&& dtp->u.p.ionml == NULL)
+	formatted_transfer (dtp, 0, NULL, 0, 0, 1);
+    }
 }
 
+
 /* Initialize an array_loop_spec given the array descriptor.  The function
    returns the index of the last element of the array, and also returns
    starting record, where the first I/O goes to (necessary in case of
@@ -3531,14 +3545,14 @@ finalize_transfer (st_parameter_dt *dtp)
   if (dtp->u.p.eor_condition)
     {
       generate_error (&dtp->common, LIBERROR_EOR, NULL);
-      return;
+      goto done;
     }
 
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     {
       if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL)
 	dtp->u.p.current_unit->current_record = 0;
-      return;
+      goto done;
     }
 
   if ((dtp->u.p.ionml != NULL)
@@ -3552,12 +3566,12 @@ finalize_transfer (st_parameter_dt *dtp)
 
   dtp->u.p.transfer = NULL;
   if (dtp->u.p.current_unit == NULL)
-    return;
+    goto done;
 
   if ((cf & IOPARM_DT_LIST_FORMAT) != 0 && dtp->u.p.mode == READING)
     {
       finish_list_read (dtp);
-      return;
+      goto done;
     }
 
   if (dtp->u.p.mode == WRITING)
@@ -3570,7 +3584,7 @@ finalize_transfer (st_parameter_dt *dtp)
 	  && dtp->u.p.advance_status != ADVANCE_NO)
 	next_record (dtp, 1);
 
-      return;
+      goto done;
     }
 
   dtp->u.p.current_unit->current_record = 0;
@@ -3579,7 +3593,7 @@ finalize_transfer (st_parameter_dt *dtp)
     {
       fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
       dtp->u.p.seen_dollar = 0;
-      return;
+      goto done;
     }
 
   /* For non-advancing I/O, save the current maximum position for use in the
@@ -3591,7 +3605,7 @@ finalize_transfer (st_parameter_dt *dtp)
       dtp->u.p.current_unit->saved_pos =
 	dtp->u.p.max_pos > 0 ? dtp->u.p.max_pos - bytes_written : 0;
       fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
-      return;
+      goto done;
     }
   else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED 
            && dtp->u.p.mode == WRITING && !is_internal_unit (dtp))
@@ -3600,6 +3614,23 @@ finalize_transfer (st_parameter_dt *dtp)
   dtp->u.p.current_unit->saved_pos = 0;
 
   next_record (dtp, 1);
+
+ done:
+#ifdef HAVE_USELOCALE
+  if (dtp->u.p.old_locale != (locale_t) 0)
+    {
+      uselocale (dtp->u.p.old_locale);
+      dtp->u.p.old_locale = (locale_t) 0;
+    }
+#else
+  __gthread_mutex_lock (&old_locale_lock);
+  if (!--old_locale_ctr)
+    {
+      setlocale (LC_NUMERIC, old_locale);
+      old_locale = NULL;
+    }
+  __gthread_mutex_unlock (&old_locale_lock);
+#endif
 }
 
 /* Transfer function for IOLENGTH. It doesn't actually do any
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 2a31e55..277c7a1 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -90,6 +90,26 @@ static char stdin_name[] = "stdin";
 static char stdout_name[] = "stdout";
 static char stderr_name[] = "stderr";
 
+
+#ifdef HAVE_NEWLOCALE
+locale_t c_locale;
+#else
+/* If we don't have POSIX 2008 per-thread locales, we need to use the
+   traditional setlocale().  To prevent multiple concurrent threads
+   doing formatted I/O from messing up the locale, we need to store a
+   global old_locale, and a counter keeping track of how many threads
+   are currently doing formatted I/O.  The first thread saves the old
+   locale, and the last one restores it.  */
+char *old_locale;
+int old_locale_ctr;
+#ifdef __GTHREAD_MUTEX_INIT
+__gthread_mutex_t old_locale_lock = __GTHREAD_MUTEX_INIT;
+#else
+__gthread_mutex_t old_locale_lock;
+#endif
+#endif
+
+
 /* This implementation is based on Stefan Nilsson's article in the
  * July 1997 Doctor Dobb's Journal, "Treaps in Java". */
 
@@ -561,6 +581,14 @@ init_units (void)
   gfc_unit *u;
   unsigned int i;
 
+#ifdef HAVE_NEWLOCALE
+  c_locale = newlocale (0, "C", 0);
+#else
+#ifndef __GTHREAD_MUTEX_INIT
+  __GTHREAD_MUTEX_INIT_FUNCTION (&old_locale_lock);
+#endif
+#endif
+
 #ifndef __GTHREAD_MUTEX_INIT
   __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
 #endif
@@ -736,6 +764,10 @@ close_units (void)
   while (unit_root != NULL)
     close_unit_1 (unit_root, 1);
   __gthread_mutex_unlock (&unit_lock);
+
+#ifdef HAVE_FREELOCALE
+  freelocale (c_locale);
+#endif
 }