diff mbox

[libfortran] PR 47007, 61847 Locale failures in libgfortran

Message ID CAO9iq9ExjQkhOi1Jm42vBvR6Y7=9bM9CS6UP9ASGc_tMC1LeHA@mail.gmail.com
State New
Headers show

Commit Message

Janne Blomqvist Nov. 6, 2014, 10:38 a.m. UTC
On Wed, Nov 5, 2014 at 12:48 PM, Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
> Hi,
>
> the attached patch fixes a few locale related failures in libgfortran,
> in the case where the POSIX 2008 extended locale functionality and
> extensions strto{f,d,ld}_l are present.
>
> These failures typically occur when libgfortran is used from a program
> which has set the locale with setlocale(), and the locale uses a
> different decimal separator than the C locale. The patch fixes this by
> creating a C locale which is then used by strto{f,d,ld}_l, and also is
> installed as the per-thread locale when starting a formatted IO, then
> reset to the previous value when the IO is done. I have chosen to not
> fallback to calling setlocale() in case the POSIX 2008 locale stuff
> isn't available, as that could create nasty hard to debug race
> conditions in a multi-threaded program.
>
> (I think Jerry's proposed patch which checks the locale for the
> decimal separator is still useful as a fallback in case the POSIX 2008
> locale stuff isn't available)

Hi,

updated patch attached. Since the patch sets the per-thread locale
with uselocale, using the non-standard strto{f,d,ld}_l functions isn't
necessary. When getting rid of this part of the original patch, I
noticed a few failures due to the uselocale() calls being in the wrong
places. These are fixed in the updated patch. Also Jakub's suggestion
has been incorporated. Further, investigation revealed that some
targets (Darwin and Freebsd) have the extended locale functionality in
xlocale.h rather than locale.h as POSIX 2008 specifies. So check for
that header. Finally, as we set the per-thread locale to "C", we'd
lose localized error messages. So the updated patch fixes this by
updating the gf_strerror() function as well.

Regtested on x86_64-unknown-linux-gnu, Ok for trunk?

2014-11-06  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.
    (st_parameter_dt): Add old_locale member.
    * io/transfer.c (data_transfer_init): Set thread locale to
    c_locale if doing formatted transfer.
    (finalize_transfer): Reset thread locale to previous.
    * io/unit.c (c_locale): New variable.
    (init_units): Init c_locale.
    (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.
diff mbox

Patch

diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index b3150f4..f54104b 100644
--- a/libgfortran/configure.ac
+++ b/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
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 1e0d092..0ff5dcc 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,11 @@  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;
+#endif
+
 
 /* Macros for testing what kinds of I/O we are doing.  */
 
@@ -450,6 +466,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..203f516 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2870,13 +2870,19 @@  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);
+#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 +3537,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 +3558,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 +3576,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 +3585,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 +3597,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 +3606,15 @@  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;
+    }
+#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..e4bc60b 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -90,6 +90,11 @@  static char stdin_name[] = "stdin";
 static char stdout_name[] = "stdout";
 static char stderr_name[] = "stderr";
 
+
+#ifdef HAVE_NEWLOCALE
+locale_t c_locale;
+#endif
+
 /* This implementation is based on Stefan Nilsson's article in the
  * July 1997 Doctor Dobb's Journal, "Treaps in Java". */
 
@@ -561,6 +566,10 @@  init_units (void)
   gfc_unit *u;
   unsigned int i;
 
+#ifdef HAVE_NEWLOCALE
+  c_locale = newlocale (0, "C", 0);
+#endif
+
 #ifndef __GTHREAD_MUTEX_INIT
   __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
 #endif
@@ -736,6 +745,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
 }
 
 
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 4bde33b..7a3a1b7 100644
--- a/libgfortran/runtime/error.c
+++ b/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))