From: Vadim Konovalov Date: Sat, 4 Nov 2000 10:15:48 +0000 (+0300) Subject: Locales support (setlocale) fixes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff4fed7c8390873fd72003ab33b27667ceea7183;p=p5sagit%2Fp5-mst-13.2.git Locales support (setlocale) fixes From: "Konovalov, Vadim" Message-ID: <402099F49BEED211999700805FC7359F82511F@ru0028exch01.spb.lucent.com> Modified quite a bit to be more portable. p4raw-id: //depot/perl@7545 --- diff --git a/embed.h b/embed.h index c50ff16..b9e7c68 100644 --- a/embed.h +++ b/embed.h @@ -1135,6 +1135,7 @@ #define isa_lookup S_isa_lookup #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#define stdize_locale S_stdize_locale #define mess_alloc S_mess_alloc # if defined(LEAKTEST) #define xstat S_xstat @@ -2588,6 +2589,7 @@ #define isa_lookup(a,b,c,d) S_isa_lookup(aTHX_ a,b,c,d) #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#define stdize_locale(a) S_stdize_locale(aTHX_ a) #define mess_alloc() S_mess_alloc(aTHX) # if defined(LEAKTEST) #define xstat(a) S_xstat(aTHX_ a) @@ -5023,6 +5025,8 @@ #define isa_lookup S_isa_lookup #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +#define S_stdize_locale CPerlObj::S_stdize_locale +#define stdize_locale S_stdize_locale #define S_mess_alloc CPerlObj::S_mess_alloc #define mess_alloc S_mess_alloc # if defined(LEAKTEST) diff --git a/embed.pl b/embed.pl index 99b73ed..cdf63ef 100755 --- a/embed.pl +++ b/embed.pl @@ -1852,9 +1852,9 @@ Apd |HV* |get_hv |const char* name|I32 create Apd |CV* |get_cv |const char* name|I32 create Ap |int |init_i18nl10n |int printwarn Ap |int |init_i18nl14n |int printwarn -Ap |void |new_collate |const char* newcoll -Ap |void |new_ctype |const char* newctype -Ap |void |new_numeric |const char* newcoll +Ap |void |new_collate |char* newcoll +Ap |void |new_ctype |char* newctype +Ap |void |new_numeric |char* newcoll Ap |void |set_numeric_local Ap |void |set_numeric_radix Ap |void |set_numeric_standard @@ -2521,6 +2521,7 @@ s |SV*|isa_lookup |HV *stash|const char *name|int len|int level #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |char* |stdize_locale |char* locs s |SV* |mess_alloc # if defined(LEAKTEST) s |void |xstat |int diff --git a/perl.h b/perl.h index 6f46dcd..80bf5ae 100644 --- a/perl.h +++ b/perl.h @@ -3139,16 +3139,10 @@ typedef struct am_table_short AMTS; #ifdef USE_LOCALE_NUMERIC #define SET_NUMERIC_STANDARD() \ - STMT_START { \ - if (! PL_numeric_standard) \ - set_numeric_standard(); \ - } STMT_END + set_numeric_standard(); #define SET_NUMERIC_LOCAL() \ - STMT_START { \ - if (! PL_numeric_local) \ - set_numeric_local(); \ - } STMT_END + set_numeric_local(); #define IS_NUMERIC_RADIX(c) \ ((PL_hints & HINT_LOCALE) && \ @@ -3156,11 +3150,11 @@ typedef struct am_table_short AMTS; #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \ - if (!was_local) SET_NUMERIC_STANDARD(); + if (was_local) SET_NUMERIC_STANDARD(); #define STORE_NUMERIC_STANDARD_SET_LOCAL() \ - bool was_standard = !(PL_hints & HINT_LOCALE) || PL_numeric_standard; \ - if (!was_standard) SET_NUMERIC_LOCAL(); + bool was_standard = (PL_hints & HINT_LOCALE) && PL_numeric_standard; \ + if (was_standard) SET_NUMERIC_LOCAL(); #define RESTORE_NUMERIC_LOCAL() \ if (was_local) SET_NUMERIC_LOCAL(); diff --git a/proto.h b/proto.h index 1d0f855..ff923a6 100644 --- a/proto.h +++ b/proto.h @@ -595,9 +595,9 @@ PERL_CALLCONV HV* Perl_get_hv(pTHX_ const char* name, I32 create); PERL_CALLCONV CV* Perl_get_cv(pTHX_ const char* name, I32 create); PERL_CALLCONV int Perl_init_i18nl10n(pTHX_ int printwarn); PERL_CALLCONV int Perl_init_i18nl14n(pTHX_ int printwarn); -PERL_CALLCONV void Perl_new_collate(pTHX_ const char* newcoll); -PERL_CALLCONV void Perl_new_ctype(pTHX_ const char* newctype); -PERL_CALLCONV void Perl_new_numeric(pTHX_ const char* newcoll); +PERL_CALLCONV void Perl_new_collate(pTHX_ char* newcoll); +PERL_CALLCONV void Perl_new_ctype(pTHX_ char* newctype); +PERL_CALLCONV void Perl_new_numeric(pTHX_ char* newcoll); PERL_CALLCONV void Perl_set_numeric_local(pTHX); PERL_CALLCONV void Perl_set_numeric_radix(pTHX); PERL_CALLCONV void Perl_set_numeric_standard(pTHX); @@ -1257,6 +1257,7 @@ STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level); #endif #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +STATIC char* S_stdize_locale(pTHX_ char* locs); STATIC SV* S_mess_alloc(pTHX); # if defined(LEAKTEST) STATIC void S_xstat(pTHX_ int); diff --git a/util.c b/util.c index 619c5aa..34cdaaf 100644 --- a/util.c +++ b/util.c @@ -466,7 +466,7 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit * Set up for a new ctype locale. */ void -Perl_new_ctype(pTHX_ const char *newctype) +Perl_new_ctype(pTHX_ char *newctype) { #ifdef USE_LOCALE_CTYPE @@ -485,10 +485,54 @@ Perl_new_ctype(pTHX_ const char *newctype) } /* + * Standardize the locale name from a string returned by 'setlocale'. + * + * The standard return value of setlocale() is either + * (1) "xx_YY" if the first argument of setlocale() is not LC_ALL + * (2) "xa_YY xb_YY ..." if the first argument of setlocale() is LC_ALL + * (the space-separated values represent the various sublocales, + * in some unspecificed order) + * + * In some platforms it has a form like "LC_SOMETHING=Lang_Country.866\n", + * which is harmful for further use of the string in setlocale(). + * + */ +STATIC char * +S_stdize_locale(pTHX_ char *locs) +{ + char *s; + bool okay = TRUE; + + if ((s = strchr(locs, '='))) { + char *t; + + okay = FALSE; + if ((t = strchr(s, '.'))) { + char *u; + + if ((u = strchr(t, '\n'))) { + + if (u[1] == 0) { + STRLEN len = u - s; + Move(t + 1, locs, len, char); + locs[len] = 0; + okay = TRUE; + } + } + } + } + + if (!okay) + Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs); + + return locs; +} + +/* * Set up for a new collation locale. */ void -Perl_new_collate(pTHX_ const char *newcoll) +Perl_new_collate(pTHX_ char *newcoll) { #ifdef USE_LOCALE_COLLATE @@ -497,17 +541,17 @@ Perl_new_collate(pTHX_ const char *newcoll) ++PL_collation_ix; Safefree(PL_collation_name); PL_collation_name = NULL; - PL_collation_standard = TRUE; - PL_collxfrm_base = 0; - PL_collxfrm_mult = 2; } + PL_collation_standard = TRUE; + PL_collxfrm_base = 0; + PL_collxfrm_mult = 2; return; } if (! PL_collation_name || strNE(PL_collation_name, newcoll)) { ++PL_collation_ix; Safefree(PL_collation_name); - PL_collation_name = savepv(newcoll); + PL_collation_name = stdize_locale(savepv(newcoll)); PL_collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX")); { @@ -551,7 +595,7 @@ Perl_set_numeric_radix(pTHX) * Set up for a new numeric locale. */ void -Perl_new_numeric(pTHX_ const char *newnum) +Perl_new_numeric(pTHX_ char *newnum) { #ifdef USE_LOCALE_NUMERIC @@ -559,15 +603,15 @@ Perl_new_numeric(pTHX_ const char *newnum) if (PL_numeric_name) { Safefree(PL_numeric_name); PL_numeric_name = NULL; - PL_numeric_standard = TRUE; - PL_numeric_local = TRUE; } + PL_numeric_standard = TRUE; + PL_numeric_local = TRUE; return; } if (! PL_numeric_name || strNE(PL_numeric_name, newnum)) { Safefree(PL_numeric_name); - PL_numeric_name = savepv(newnum); + PL_numeric_name = stdize_locale(savepv(newnum)); PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX")); PL_numeric_local = TRUE; set_numeric_radix(); @@ -585,6 +629,7 @@ Perl_set_numeric_standard(pTHX) setlocale(LC_NUMERIC, "C"); PL_numeric_standard = TRUE; PL_numeric_local = FALSE; + set_numeric_radix(); } #endif /* USE_LOCALE_NUMERIC */