make string_of_float and float_of_string locale-independent
parent
44a5e50123
commit
36d142e058
4
Changes
4
Changes
|
@ -12,6 +12,10 @@ Working version
|
||||||
|
|
||||||
### Standard library:
|
### 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
|
- GPR#1590: ocamllex-generated lexers can be instructed not to update
|
||||||
their lex_curr_p/lex_start_p fields, resulting in a significant
|
their lex_curr_p/lex_start_p fields, resulting in a significant
|
||||||
performance gain when those fields are not required
|
performance gain when those fields are not required
|
||||||
|
|
|
@ -127,6 +127,7 @@ value caml_startup_common(char_os **argv, int pooling)
|
||||||
#endif
|
#endif
|
||||||
caml_init_frame_descriptors();
|
caml_init_frame_descriptors();
|
||||||
caml_init_ieee_floats();
|
caml_init_ieee_floats();
|
||||||
|
caml_init_locale();
|
||||||
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
||||||
caml_install_invalid_parameter_handler();
|
caml_install_invalid_parameter_handler();
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -20,6 +20,9 @@
|
||||||
|
|
||||||
#include "config.h"
|
#include "config.h"
|
||||||
|
|
||||||
|
extern void caml_init_locale(void);
|
||||||
|
extern void caml_free_locale(void);
|
||||||
|
|
||||||
extern void caml_init_atom_table (void);
|
extern void caml_init_atom_table (void);
|
||||||
|
|
||||||
extern uintnat caml_init_percent_free;
|
extern uintnat caml_init_percent_free;
|
||||||
|
|
|
@ -17,6 +17,12 @@
|
||||||
|
|
||||||
/* The interface of this file is in "caml/mlvalues.h" and "caml/alloc.h" */
|
/* 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 <math.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
|
@ -32,6 +38,10 @@
|
||||||
#include "caml/reverse.h"
|
#include "caml/reverse.h"
|
||||||
#include "caml/stacks.h"
|
#include "caml/stacks.h"
|
||||||
|
|
||||||
|
#ifdef HAS_LOCALE
|
||||||
|
#include <locale.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef _MSC_VER
|
#ifdef _MSC_VER
|
||||||
#include <float.h>
|
#include <float.h>
|
||||||
#ifndef isnan
|
#ifndef isnan
|
||||||
|
@ -66,6 +76,34 @@ CAMLexport void caml_Store_double_val(value val, double dbl)
|
||||||
|
|
||||||
#endif
|
#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)
|
CAMLexport value caml_copy_double(double d)
|
||||||
{
|
{
|
||||||
value res;
|
value res;
|
||||||
|
@ -98,8 +136,14 @@ CAMLprim value caml_format_float(value fmt, value arg)
|
||||||
|
|
||||||
#ifdef HAS_BROKEN_PRINTF
|
#ifdef HAS_BROKEN_PRINTF
|
||||||
if (isfinite(d)) {
|
if (isfinite(d)) {
|
||||||
|
#endif
|
||||||
|
#ifdef HAS_LOCALE
|
||||||
|
locale_t saved_locale = uselocale(caml_locale);
|
||||||
#endif
|
#endif
|
||||||
res = caml_alloc_sprintf(String_val(fmt), d);
|
res = caml_alloc_sprintf(String_val(fmt), d);
|
||||||
|
#ifdef HAS_LOCALE
|
||||||
|
uselocale(saved_locale);
|
||||||
|
#endif
|
||||||
#ifdef HAS_BROKEN_PRINTF
|
#ifdef HAS_BROKEN_PRINTF
|
||||||
} else {
|
} else {
|
||||||
if (isnan(d)) {
|
if (isnan(d)) {
|
||||||
|
@ -321,8 +365,18 @@ CAMLprim value caml_float_of_string(value vs)
|
||||||
}
|
}
|
||||||
*dst = 0;
|
*dst = 0;
|
||||||
if (dst == buf) goto error;
|
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 */
|
/* Convert using strtod */
|
||||||
d = strtod((const char *) buf, &end);
|
d = strtod((const char *) buf, &end);
|
||||||
|
#ifdef HAS_LOCALE
|
||||||
|
uselocale(saved_locale);
|
||||||
|
#endif
|
||||||
|
#endif /* HAS_STRTOD_L */
|
||||||
if (end != dst) goto error;
|
if (end != dst) goto error;
|
||||||
if (buf != parse_buffer) caml_stat_free(buf);
|
if (buf != parse_buffer) caml_stat_free(buf);
|
||||||
return caml_copy_double(d);
|
return caml_copy_double(d);
|
||||||
|
|
|
@ -346,6 +346,7 @@ CAMLexport void caml_main(char_os **argv)
|
||||||
/* Machine-dependent initialization of the floating-point hardware
|
/* Machine-dependent initialization of the floating-point hardware
|
||||||
so that it behaves as much as possible as specified in IEEE */
|
so that it behaves as much as possible as specified in IEEE */
|
||||||
caml_init_ieee_floats();
|
caml_init_ieee_floats();
|
||||||
|
caml_init_locale();
|
||||||
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
||||||
caml_install_invalid_parameter_handler();
|
caml_install_invalid_parameter_handler();
|
||||||
#endif
|
#endif
|
||||||
|
@ -478,6 +479,7 @@ CAMLexport value caml_startup_code_exn(
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
|
|
||||||
caml_init_ieee_floats();
|
caml_init_ieee_floats();
|
||||||
|
caml_init_locale();
|
||||||
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
||||||
caml_install_invalid_parameter_handler();
|
caml_install_invalid_parameter_handler();
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -159,6 +159,7 @@ CAMLexport void caml_shutdown(void)
|
||||||
call_registered_value("Pervasives.do_at_exit");
|
call_registered_value("Pervasives.do_at_exit");
|
||||||
call_registered_value("Thread.at_shutdown");
|
call_registered_value("Thread.at_shutdown");
|
||||||
caml_finalise_heap();
|
caml_finalise_heap();
|
||||||
|
caml_free_locale();
|
||||||
#ifndef NATIVE_CODE
|
#ifndef NATIVE_CODE
|
||||||
caml_free_shared_libs();
|
caml_free_shared_libs();
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -188,7 +188,11 @@
|
||||||
#define HAS_LOCALE
|
#define HAS_LOCALE
|
||||||
|
|
||||||
/* Define HAS_LOCALE if you have the include file <locale.h> and the
|
/* 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
|
#define HAS_MMAP
|
||||||
|
|
||||||
|
|
|
@ -1483,11 +1483,16 @@ if sh ./hasgot putenv; then
|
||||||
echo "#define HAS_PUTENV" >> s.h
|
echo "#define HAS_PUTENV" >> s.h
|
||||||
fi
|
fi
|
||||||
|
|
||||||
if sh ./hasgot -i locale.h && sh ./hasgot setlocale; then
|
if sh ./hasgot -i locale.h && sh ./hasgot newlocale duplocale freelocale uselocale; then
|
||||||
inf "setlocale() and <locale.h> found."
|
inf "newlocale() and <locale.h> found."
|
||||||
echo "#define HAS_LOCALE" >> s.h
|
echo "#define HAS_LOCALE" >> s.h
|
||||||
fi
|
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
|
if sh ./hasgot $dllib dlopen; then
|
||||||
inf "dlopen() found."
|
inf "dlopen() found."
|
||||||
|
|
|
@ -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
|
|
@ -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;
|
||||||
|
}
|
|
@ -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 ();
|
||||||
|
()
|
|
@ -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
|
Loading…
Reference in New Issue