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

gcc/fortran/ChangeLog

@@ -1,3 +1,10 @@
+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.
+
 2014-11-04  Bernd Schmidt  <bernds@codesourcery.com>
 
 	* f95-lang.c (gfc_init_builtin_functions): Use type index 2 for

gcc/fortran/gfortran.texi

@@ -1223,10 +1223,26 @@ implemented with the @code{system} function, which need not be
 thread-safe.  It is the responsibility of the user to ensure that
 @code{system} is not called concurrently.
 
-Finally, for platforms not supporting thread-safe POSIX functions,
+For platforms not supporting thread-safe POSIX functions, further
-further functionality might not be thread-safe.  For details, please
+functionality might not be thread-safe.  For details, please consult
-consult the documentation for your operating system.
+the documentation for your operating system.
 
+The GNU Fortran runtime library uses various C library functions that
+depend on the locale, such as @code{strtod} and @code{snprintf}.  In
+order to work correctly in locale-aware programs that set the locale
+using @code{setlocale}, the locale is reset to the default ``C''
+locale while executing a formatted @code{READ} or @code{WRITE}
+statement.  On targets supporting the POSIX 2008 per-thread locale
+functions (e.g. @code{newlocale}, @code{uselocale},
+@code{freelocale}), these are used and thus the global locale set
+using @code{setlocale} or the per-thread locales in other threads are
+not affected.  However, on targets lacking this functionality, the
+global LC_NUMERIC locale is set to ``C'' during the formatted I/O.
+Thus, on such targets it's not safe to call @code{setlocale}
+concurrently from another thread while a Fortran formatted I/O
+operation is in progress.  Also, other threads doing something
+dependent on the LC_NUMERIC locale might not work correctly if a
+formatted I/O operation is in progress in another thread.
 
 @node Data consistency and durability
 @section Data consistency and durability

libgfortran/ChangeLog

@@ -1,3 +1,33 @@
+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-10-20  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR libfortran/63589

libgfortran/config.h.in

@@ -429,6 +429,9 @@
 /* fp_trap is present */
 #undef HAVE_FP_TRAP
 
+/* Define to 1 if you have the `freelocale' function. */
+#undef HAVE_FREELOCALE
+
 /* Define to 1 if you have the `frexp' function. */
 #undef HAVE_FREXP
 
@@ -621,6 +624,9 @@
 /* Define to 1 if you have the `mkstemp' function. */
 #undef HAVE_MKSTEMP
 
+/* Define to 1 if you have the `newlocale' function. */
+#undef HAVE_NEWLOCALE
+
 /* Define to 1 if you have the `nextafter' function. */
 #undef HAVE_NEXTAFTER
 
@@ -723,6 +729,9 @@
 /* Define to 1 if you have the `strcasestr' function. */
 #undef HAVE_STRCASESTR
 
+/* Define to 1 if you have the `strerror_l' function. */
+#undef HAVE_STRERROR_L
+
 /* Define if strerror_r is available in <string.h>. */
 #undef HAVE_STRERROR_R
 
@@ -840,6 +849,9 @@
 /* Define if target can unlink open files. */
 #undef HAVE_UNLINK_OPEN_FILE
 
+/* Define to 1 if you have the `uselocale' function. */
+#undef HAVE_USELOCALE
+
 /* Define to 1 if you have the `vsnprintf' function. */
 #undef HAVE_VSNPRINTF
 
@@ -849,6 +861,9 @@
 /* Define if target has a reliable stat. */
 #undef HAVE_WORKING_STAT
 
+/* Define to 1 if you have the <xlocale.h> header file. */
+#undef HAVE_XLOCALE_H
+
 /* Define to 1 if you have the `y0' function. */
 #undef HAVE_Y0
 

libgfortran/configure

@@ -2549,6 +2549,7 @@ as_fn_append ac_header_list " fptrap.h"
 as_fn_append ac_header_list " fpxcp.h"
 as_fn_append ac_header_list " pwd.h"
 as_fn_append ac_header_list " complex.h"
+as_fn_append ac_header_list " xlocale.h"
 as_fn_append ac_func_list " getrusage"
 as_fn_append ac_func_list " times"
 as_fn_append ac_func_list " mkstemp"
@@ -2605,6 +2606,10 @@ as_fn_append ac_func_list " mkostemp"
 as_fn_append ac_func_list " strnlen"
 as_fn_append ac_func_list " strndup"
 as_fn_append ac_func_list " strtok_r"
+as_fn_append ac_func_list " newlocale"
+as_fn_append ac_func_list " freelocale"
+as_fn_append ac_func_list " uselocale"
+as_fn_append ac_func_list " strerror_l"
 as_fn_append ac_header_list " math.h"
 # Check that the precious variables saved in the cache have kept the same
 # value.
@@ -12350,7 +12355,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12353 "configure"
+#line 12358 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -12456,7 +12461,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12459 "configure"
+#line 12464 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -16016,6 +16021,8 @@ done
 
 
 
+
+
 
 
 
@@ -16618,6 +16625,14 @@ done
 
 
 
+
+
+
+
+
+
+
+
 
 
 

libgfortran/configure.ac

@@ -255,7 +255,7 @@ AC_CHECK_TYPES([ptrdiff_t])
 # check header files (we assume C89 is available, so don't check for that)
 AC_CHECK_HEADERS_ONCE(unistd.h sys/time.h sys/times.h sys/resource.h \
 sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h fenv.h fptrap.h \
-fpxcp.h pwd.h complex.h) 
+fpxcp.h pwd.h complex.h xlocale.h)
 
 GCC_HEADER_STDINT(gstdint.h)
 
@@ -290,7 +290,8 @@ else
    strcasestr getrlimit gettimeofday stat fstat lstat getpwuid vsnprintf dup \
    getcwd localtime_r gmtime_r getpwuid_r ttyname_r clock_gettime \
    readlink getgid getpid getppid getuid geteuid umask getegid \
-   secure_getenv __secure_getenv mkostemp strnlen strndup strtok_r)
+   secure_getenv __secure_getenv mkostemp strnlen strndup strtok_r newlocale \
+   freelocale uselocale strerror_l)
 fi
 
 # Check strerror_r, cannot be above as versions with two and three arguments exist

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

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)
-  if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED
+    {
-      && ((cf & (IOPARM_DT_LIST_FORMAT | IOPARM_DT_HAS_NAMELIST_NAME)) == 0)
+#ifdef HAVE_USELOCALE
-      && dtp->u.p.ionml == NULL)
+      dtp->u.p.old_locale = uselocale (c_locale);
-    formatted_transfer (dtp, 0, NULL, 0, 0, 1);
+#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

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
 }
 
 

libgfortran/runtime/error.c

@@ -46,6 +46,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #endif
 
 
+#include <locale.h>
+
+#ifdef HAVE_XLOCALE_H
+#include <xlocale.h>
+#endif
+
+
 #ifdef __MINGW32__
 #define HAVE_GETPID 1
 #include <process.h>
@@ -204,14 +211,26 @@ gfc_xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
 }
 
 
-/* Hopefully thread-safe wrapper for a strerror_r() style function.  */
+/* Hopefully thread-safe wrapper for a strerror() style function.  */
 
 char *
 gf_strerror (int errnum, 
              char * buf __attribute__((unused)), 
 	     size_t buflen __attribute__((unused)))
 {
-#ifdef HAVE_STRERROR_R
+#ifdef HAVE_STRERROR_L
+  locale_t myloc = newlocale (LC_CTYPE_MASK | LC_MESSAGES_MASK, "",
+			      (locale_t) 0);
+  char *p = strerror_l (errnum, myloc);
+  freelocale (myloc);
+  return p;
+#elif defined(HAVE_STRERROR_R)
+#ifdef HAVE_USELOCALE
+  /* Some targets (Darwin at least) have the POSIX 2008 extended
+     locale functions, but not strerror_l.  So reset the per-thread
+     locale here.  */
+  uselocale (LC_GLOBAL_LOCALE);
+#endif
   /* POSIX returns an "int", GNU a "char*".  */
   return
     __builtin_choose_expr (__builtin_classify_type (strerror_r (0, buf, 0))