make string_of_float and float_of_string locale-independent

Changes

@@ -12,6 +12,10 @@ Working version
 
 ### Standard library:
 
+- MPR#6701, GPR#1185, GPR#1803: make float_of_string and string_of_float
+  locale-independent
+  (ygrek, review by Xavier Leroy and Damien Doligez)
+
 - GPR#1590: ocamllex-generated lexers can be instructed not to update
   their lex_curr_p/lex_start_p fields, resulting in a significant
   performance gain when those fields are not required

asmrun/startup.c

@@ -127,6 +127,7 @@ value caml_startup_common(char_os **argv, int pooling)
 #endif
   caml_init_frame_descriptors();
   caml_init_ieee_floats();
+  caml_init_locale();
 #if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
   caml_install_invalid_parameter_handler();
 #endif

byterun/caml/startup_aux.h

@@ -20,6 +20,9 @@
 
 #include "config.h"
 
+extern void caml_init_locale(void);
+extern void caml_free_locale(void);
+
 extern void caml_init_atom_table (void);
 
 extern uintnat caml_init_percent_free;

byterun/floats.c

@@ -17,6 +17,12 @@
 
 /* The interface of this file is in "caml/mlvalues.h" and "caml/alloc.h" */
 
+/* Needed for uselocale */
+#define _XOPEN_SOURCE 700
+
+/* Needed for strtod_l */
+#define _GNU_SOURCE
+
 #include <math.h>
 #include <stdio.h>
 #include <stdlib.h>
@@ -32,6 +38,10 @@
 #include "caml/reverse.h"
 #include "caml/stacks.h"
 
+#ifdef HAS_LOCALE
+#include <locale.h>
+#endif
+
 #ifdef _MSC_VER
 #include <float.h>
 #ifndef isnan
@@ -66,6 +76,34 @@ CAMLexport void caml_Store_double_val(value val, double dbl)
 
 #endif
 
+/*
+ OCaml runtime itself doesn't call setlocale, i.e. it is using
+ standard "C" locale by default, but it is possible that
+ thirt-party code loaded into process does.
+*/
+#ifdef HAS_LOCALE
+locale_t caml_locale = 0;
+#endif
+
+void caml_init_locale(void)
+{
+#ifdef HAS_LOCALE
+  if (0 == caml_locale)
+  {
+    caml_locale = duplocale(LC_GLOBAL_LOCALE);
+    caml_locale = newlocale(LC_NUMERIC_MASK,"C",caml_locale);
+  }
+#endif
+}
+
+void caml_free_locale(void)
+{
+#ifdef HAS_LOCALE
+  if (0 != caml_locale) freelocale(caml_locale);
+  caml_locale = 0;
+#endif
+}
+
 CAMLexport value caml_copy_double(double d)
 {
   value res;
@@ -98,8 +136,14 @@ CAMLprim value caml_format_float(value fmt, value arg)
 
 #ifdef HAS_BROKEN_PRINTF
   if (isfinite(d)) {
+#endif
+#ifdef HAS_LOCALE
+    locale_t saved_locale = uselocale(caml_locale);
 #endif
     res = caml_alloc_sprintf(String_val(fmt), d);
+#ifdef HAS_LOCALE
+    uselocale(saved_locale);
+#endif
 #ifdef HAS_BROKEN_PRINTF
   } else {
     if (isnan(d)) {
@@ -321,8 +365,18 @@ CAMLprim value caml_float_of_string(value vs)
   }
   *dst = 0;
   if (dst == buf) goto error;
+#ifdef HAS_STRTOD_L
+  d = strtod_l((const char *) buf, &end, caml_locale);
+#else
+#ifdef HAS_LOCALE
+  locale_t saved_locale = uselocale(caml_locale);
+#endif
   /* Convert using strtod */
   d = strtod((const char *) buf, &end);
+#ifdef HAS_LOCALE
+  uselocale(saved_locale);
+#endif
+#endif /* HAS_STRTOD_L */
   if (end != dst) goto error;
   if (buf != parse_buffer) caml_stat_free(buf);
   return caml_copy_double(d);

byterun/startup.c

@@ -346,6 +346,7 @@ CAMLexport void caml_main(char_os **argv)
   /* Machine-dependent initialization of the floating-point hardware
      so that it behaves as much as possible as specified in IEEE */
   caml_init_ieee_floats();
+  caml_init_locale();
 #if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
   caml_install_invalid_parameter_handler();
 #endif
@@ -478,6 +479,7 @@ CAMLexport value caml_startup_code_exn(
     return Val_unit;
 
   caml_init_ieee_floats();
+  caml_init_locale();
 #if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
   caml_install_invalid_parameter_handler();
 #endif

byterun/startup_aux.c

@@ -159,6 +159,7 @@ CAMLexport void caml_shutdown(void)
   call_registered_value("Pervasives.do_at_exit");
   call_registered_value("Thread.at_shutdown");
   caml_finalise_heap();
+  caml_free_locale();
 #ifndef NATIVE_CODE
   caml_free_shared_libs();
 #endif

config/s-templ.h

@@ -188,7 +188,11 @@
 #define HAS_LOCALE
 
 /* Define HAS_LOCALE if you have the include file <locale.h> and the
-   setlocale() function. */
+   uselocale() function. */
+
+#define HAS_STRTOD_L
+
+/* Define HAS_STRTOD_L if you have strtod_l */
 
 #define HAS_MMAP
 

configure

@@ -1483,11 +1483,16 @@ if sh ./hasgot putenv; then
   echo "#define HAS_PUTENV" >> s.h
 fi
 
-if sh ./hasgot -i locale.h && sh ./hasgot setlocale; then
-  inf "setlocale() and <locale.h> found."
+if sh ./hasgot -i locale.h && sh ./hasgot newlocale duplocale freelocale uselocale; then
+  inf "newlocale() and <locale.h> found."
   echo "#define HAS_LOCALE" >> s.h
 fi
 
+if sh ./hasgot strtod_l; then
+  inf "strtod_l() found."
+  echo "#define HAS_STRTOD_L" >> s.h
+fi
+
 
 if sh ./hasgot $dllib dlopen; then
   inf "dlopen() found."

testsuite/tests/locale/Makefile

@@ -0,0 +1,9 @@
+BASEDIR=../..
+MODULES=
+MAIN_MODULE=test
+C_FILES=stubs
+
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
+
+NATIVECODE_ONLY=true

testsuite/tests/locale/stubs.c

@@ -0,0 +1,8 @@
+#include <caml/mlvalues.h>
+#include <locale.h>
+
+value ml_setlocale(value v_locale)
+{
+  setlocale(LC_ALL,String_val(v_locale));
+  return Val_unit;
+}

testsuite/tests/locale/test.ml

@@ -0,0 +1,24 @@
+
+external setlocale : string -> unit = "ml_setlocale"
+
+let show f = try string_of_float @@ f () with exn -> Printf.sprintf "exn %s" (Printexc.to_string exn)
+let pr fmt = Printf.ksprintf print_endline fmt
+
+let () =
+  let s = "12345.6789" in
+  let f = 1.23 in
+  let test () =
+    pr "  print 1.23 : %s" (show @@ fun () -> f);
+    pr "  parse %S : %s" s (show @@ fun () -> float_of_string s);
+    pr "  roundtrip 1.23 : %s" (show @@ fun () -> float_of_string @@ string_of_float f);
+  in
+  pr "locale from environment";
+  setlocale "";
+  test ();
+  pr "locale nl_NL";
+  setlocale "nl_NL";
+  test ();
+  pr "locale POSIX";
+  setlocale "C";
+  test ();
+  ()

testsuite/tests/locale/test.reference

@@ -0,0 +1,12 @@
+locale from environment
+  print 1.23 : 1.23
+  parse "12345.6789" : 12345.6789
+  roundtrip 1.23 : 1.23
+locale nl_NL
+  print 1.23 : 1.23
+  parse "12345.6789" : 12345.6789
+  roundtrip 1.23 : 1.23
+locale POSIX
+  print 1.23 : 1.23
+  parse "12345.6789" : 12345.6789
+  roundtrip 1.23 : 1.23