This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add sync_locale()
authorKarl Williamson <khw@cpan.org>
Thu, 14 Aug 2014 17:56:03 +0000 (11:56 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 14 Aug 2014 18:04:39 +0000 (12:04 -0600)
This trivial function is to be used by XS code when it changes the
program's locale.  It hides the details from that code of what needs to
be done, which could change in the future.

embed.fnc
embed.h
locale.c
proto.h

index b70404d..0bde316 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1112,6 +1112,7 @@ Ap        |void   |set_numeric_local
 Ap     |void   |set_numeric_radix
 Ap     |void   |set_numeric_standard
 ApM    |bool   |_is_in_locale_category|const bool compiling|const int category
+Apd    |void   |sync_locale
 ApdO   |void   |require_pv     |NN const char* pv
 Apd    |void   |pack_cat       |NN SV *cat|NN const char *pat|NN const char *patend \
                                |NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags
diff --git a/embed.h b/embed.h
index 3962901..7b8d471 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define sv_vsetpvfn(a,b,c,d,e,f,g)     Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
 #define swash_fetch(a,b,c)     Perl_swash_fetch(aTHX_ a,b,c)
 #define swash_init(a,b,c,d,e)  Perl_swash_init(aTHX_ a,b,c,d,e)
+#define sync_locale()          Perl_sync_locale(aTHX)
 #define taint_env()            Perl_taint_env(aTHX)
 #define taint_proper(a,b)      Perl_taint_proper(aTHX_ a,b)
 #define tmps_grow(a)           Perl_tmps_grow(aTHX_ a)
index cfe15cb..8f77885 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -1558,6 +1558,41 @@ Perl_my_strerror(pTHX_ const int errnum) {
 }
 
 /*
+
+=head1 Locale-related functions and macros
+
+=for apidoc sync_locale
+
+Changing the program's locale should be avoided by XS code.  Nevertheless,
+certain non-Perl libraries called from XS, such as C<Gtk> do so.  When this
+happens, Perl needs to be told that the locale has changed.  Use this function
+to do so, before returning to Perl.
+
+=cut
+*/
+
+void
+Perl_sync_locale(pTHX)
+{
+
+#ifdef USE_LOCALE_CTYPE
+    new_ctype(setlocale(LC_CTYPE, NULL));
+#endif /* USE_LOCALE_CTYPE */
+
+#ifdef USE_LOCALE_COLLATE
+    new_collate(setlocale(LC_COLLATE, NULL));
+#endif
+
+#ifdef USE_LOCALE_NUMERIC
+    set_numeric_local();    /* Switch from "C" to underlying LC_NUMERIC */
+    new_numeric(setlocale(LC_NUMERIC, NULL));
+#endif /* USE_LOCALE_NUMERIC */
+
+}
+
+
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
diff --git a/proto.h b/proto.h
index 1e42903..19ec194 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4690,6 +4690,7 @@ PERL_CALLCONV SV* Perl_swash_init(pTHX_ const char* pkg, const char* name, SV* l
 #define PERL_ARGS_ASSERT_SWASH_INIT    \
        assert(pkg); assert(name); assert(listsv)
 
+PERL_CALLCONV void     Perl_sync_locale(pTHX);
 PERL_CALLCONV void     Perl_sys_init(int* argc, char*** argv)
                        __attribute__nonnull__(1)
                        __attribute__nonnull__(2);