From: Karl Williamson Date: Sat, 15 Feb 2014 19:58:07 +0000 (-0700) Subject: Emulate POSIX locale setting on Windows X-Git-Tag: upstream/5.20.0~420 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=b385bb4ddcb252e69a1044d702646741e2e489fb;p=platform%2Fupstream%2Fperl.git Emulate POSIX locale setting on Windows Locale initialization and setting on Windows haven't been as described in perllocale for setting locales to "". This is because that tells Windows to use the system default locale, as set through the Control Panel, but on POSIX systems, it means to look at various environment variables. This commit creates a wrapper for setlocale, used only on Windows, that looks for the appropriate environment variables when called with a "" input locale. If none are found, it continues to use the system default locale. --- diff --git a/embed.fnc b/embed.fnc index 6f743e4..e9795a7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1069,6 +1069,11 @@ ApdO |AV* |get_av |NN const char *name|I32 flags ApdO |HV* |get_hv |NN const char *name|I32 flags ApdO |CV* |get_cv |NN const char* name|I32 flags Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags +#ifdef WIN32 +ApPM |char* |my_setlocale |int category|NULLOK const char* locale +#else +AmPM |char* |my_setlocale |int category|NULLOK const char* locale +#endif ApOM |int |init_i18nl10n |int printwarn ApOM |int |init_i18nl14n |int printwarn ApOM |void |new_collate |NULLOK const char* newcoll diff --git a/embed.h b/embed.h index d1224eb..1075912 100644 --- a/embed.h +++ b/embed.h @@ -849,6 +849,9 @@ #define PerlIO_unread(a,b,c) Perl_PerlIO_unread(aTHX_ a,b,c) #define PerlIO_write(a,b,c) Perl_PerlIO_write(aTHX_ a,b,c) #endif +#if defined(WIN32) +#define my_setlocale(a,b) Perl_my_setlocale(aTHX_ a,b) +#endif #if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS) #define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c) #define do_spawn(a) Perl_do_spawn(aTHX_ a) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 08e459c..f8d7c24 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -951,7 +951,11 @@ setlocale(category, locale = 0) PREINIT: char * retval; CODE: +#ifdef WIN32 /* Use wrapper on Windows */ + retval = Perl_my_setlocale(aTHX_ category, locale); +#else retval = setlocale(category, locale); +#endif if (! retval) { XSRETURN_UNDEF; } diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 83a9e2c..0ca9ee9 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.38_01'; +our $VERSION = '1.38_02'; require XSLoader; diff --git a/locale.c b/locale.c index 6654468..18f5ee9 100644 --- a/locale.c +++ b/locale.c @@ -331,6 +331,85 @@ Perl_new_collate(pTHX_ const char *newcoll) #endif /* USE_LOCALE_COLLATE */ } +#ifdef WIN32 + +char * +Perl_my_setlocale(pTHX_ int category, const char* locale) +{ + /* This, for Windows, emulates POSIX setlocale() behavior. There is no + * difference unless the input locale is "", which means on Windows to get + * the machine default, which is set via the computer's "Regional and + * Language Options" (or its current equivalent). In POSIX, it instead + * means to find the locale from the user's environment. This routine + * looks in the environment, and, if anything is found, uses that instead + * of going to the machine default. If there is no environment override, + * the machine default is used, as normal, by calling the real setlocale() + * with "". The POSIX behavior is to use the LC_ALL variable if set; + * otherwise to use the particular category's variable if set; otherwise to + * use the LANG variable. */ + + if (locale && strEQ(locale, "")) { +# ifdef LC_ALL + locale = PerlEnv_getenv("LC_ALL"); + if (! locale) { +#endif + switch (category) { +# ifdef LC_ALL + case LC_ALL: + break; /* We already know its variable isn't set */ +# endif +# ifdef USE_LOCALE_TIME + case LC_TIME: + locale = PerlEnv_getenv("LC_TIME"); + break; +# endif +# ifdef USE_LOCALE_CTYPE + case LC_CTYPE: + locale = PerlEnv_getenv("LC_CTYPE"); + break; +# endif +# ifdef USE_LOCALE_COLLATE + case LC_COLLATE: + locale = PerlEnv_getenv("LC_COLLATE"); + break; +# endif +# ifdef USE_LOCALE_MONETARY + case LC_MONETARY: + locale = PerlEnv_getenv("LC_MONETARY"); + break; +# endif +# ifdef USE_LOCALE_NUMERIC + case LC_NUMERIC: + locale = PerlEnv_getenv("LC_NUMERIC"); + break; +# endif +# ifdef USE_LOCALE_MESSAGES + case LC_MESSAGES: + locale = PerlEnv_getenv("LC_MESSAGES"); + break; +# endif + default: + /* This is a category, like PAPER_SIZE that we don't + * know about; and so can't provide a wrapper. */ + break; + } + if (! locale) { + locale = PerlEnv_getenv("LANG"); + if (! locale) { + locale = ""; + } + } +# ifdef LC_ALL + } +# endif + } + + return setlocale(category, locale); +} + +#endif + + /* * Initialize locale awareness. */ @@ -378,7 +457,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) # ifdef LC_ALL if (lang) { - if (setlocale(LC_ALL, setlocale_init)) + if (my_setlocale(LC_ALL, setlocale_init)) done = TRUE; else setlocale_failure = TRUE; @@ -387,7 +466,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) # ifdef USE_LOCALE_CTYPE Safefree(curctype); if (! (curctype = - setlocale(LC_CTYPE, + my_setlocale(LC_CTYPE, (!done && (lang || PerlEnv_getenv("LC_CTYPE"))) ? setlocale_init : NULL))) setlocale_failure = TRUE; @@ -397,7 +476,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) # ifdef USE_LOCALE_COLLATE Safefree(curcoll); if (! (curcoll = - setlocale(LC_COLLATE, + my_setlocale(LC_COLLATE, (!done && (lang || PerlEnv_getenv("LC_COLLATE"))) ? setlocale_init : NULL))) setlocale_failure = TRUE; @@ -407,7 +486,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) # ifdef USE_LOCALE_NUMERIC Safefree(curnum); if (! (curnum = - setlocale(LC_NUMERIC, + my_setlocale(LC_NUMERIC, (!done && (lang || PerlEnv_getenv("LC_NUMERIC"))) ? setlocale_init : NULL))) setlocale_failure = TRUE; @@ -421,28 +500,28 @@ Perl_init_i18nl10n(pTHX_ int printwarn) #endif /* !LOCALE_ENVIRON_REQUIRED */ #ifdef LC_ALL - if (! setlocale(LC_ALL, setlocale_init)) + if (! my_setlocale(LC_ALL, setlocale_init)) setlocale_failure = TRUE; #endif /* LC_ALL */ if (!setlocale_failure) { #ifdef USE_LOCALE_CTYPE Safefree(curctype); - if (! (curctype = setlocale(LC_CTYPE, setlocale_init))) + if (! (curctype = my_setlocale(LC_CTYPE, setlocale_init))) setlocale_failure = TRUE; else curctype = savepv(curctype); #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE Safefree(curcoll); - if (! (curcoll = setlocale(LC_COLLATE, setlocale_init))) + if (! (curcoll = my_setlocale(LC_COLLATE, setlocale_init))) setlocale_failure = TRUE; else curcoll = savepv(curcoll); #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC Safefree(curnum); - if (! (curnum = setlocale(LC_NUMERIC, setlocale_init))) + if (! (curnum = my_setlocale(LC_NUMERIC, setlocale_init))) setlocale_failure = TRUE; else curnum = savepv(curnum); diff --git a/perl.h b/perl.h index 0503209..e940ab6 100644 --- a/perl.h +++ b/perl.h @@ -702,6 +702,9 @@ # if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY) # define USE_LOCALE_MONETARY # endif +# ifndef WIN32 /* No wrapper except on Windows */ +# define my_setlocale(a,b) setlocale(a,b) +# endif #endif /* !NO_LOCALE && HAS_SETLOCALE */ #include diff --git a/pod/perldelta.pod b/pod/perldelta.pod index c1c6fbb..490a260 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -726,6 +726,12 @@ calculate byte offsets for a large portion of the string. [perl C< for ( $h{k} || '' ) > no longer auto-vivifies C<$h{k}>. [perl #120374] +=item * + +On Windows machines, Perl now emulates the POSIX use of the environment +for locale initialization. Previously, the environment was ignored. +See L. + =back =head1 Known Problems diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 0698b34..be41f0a 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -1115,7 +1115,8 @@ and you should investigate what the problem is. The following environment variables are not specific to Perl: They are part of the standardized (ISO C, XPG4, POSIX 1.c) C method -for controlling an application's opinion on data. +for controlling an application's opinion on data. Windows is non-POSIX, +but Perl arranges for the following to work as described anyway. =over 12 diff --git a/proto.h b/proto.h index 88e246a..9c2640f 100644 --- a/proto.h +++ b/proto.h @@ -5082,6 +5082,11 @@ PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* idop assert(idop) #endif +#if !(defined(WIN32)) +/* PERL_CALLCONV char* my_setlocale(pTHX_ int category, const char* locale) + __attribute__pure__; */ + +#endif #if !(defined(_MSC_VER)) PERL_CALLCONV_NO_RET int Perl_magic_regdatum_set(pTHX_ SV* sv, MAGIC* mg) __attribute__noreturn__ @@ -8061,6 +8066,9 @@ PERL_CALLCONV SSize_t Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_ #endif #if defined(WIN32) +PERL_CALLCONV char* Perl_my_setlocale(pTHX_ int category, const char* locale) + __attribute__pure__; + PERL_CALLCONV_NO_RET void win32_croak_not_implemented(const char * fname) __attribute__noreturn__ __attribute__nonnull__(1);