From 0fe4d7f53271875ddab9f5e0b0a212f9b7878acb Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Sat, 4 Nov 2000 23:39:05 +0000 Subject: [PATCH] Integrate mainline again p4raw-id: //depot/perlio@7550 --- Configure | 8 +++++--- embed.h | 4 ++++ embed.pl | 7 ++++--- perl.h | 16 +++++---------- proto.h | 7 ++++--- t/lib/b.t | 2 +- t/op/misc.t | 2 +- util.c | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++---------- 8 files changed, 79 insertions(+), 32 deletions(-) diff --git a/Configure b/Configure index 89df03f..13e52db 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Sat Nov 4 01:58:40 EET 2000 [metaconfig 3.0 PL70] +# Generated on Sun Nov 5 00:37:41 EET 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >/tmp/c1$$ <&4 tmp_n="$n" tmp_c="$c" @@ -2675,7 +2678,6 @@ cd UU ;; esac test "$override" && . ./optdef.sh -myuname="$newmyuname" : Restore computed paths for file in $loclist $trylist; do 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/t/lib/b.t b/t/lib/b.t index fca7f47..2bca033 100755 --- a/t/lib/b.t +++ b/t/lib/b.t @@ -126,7 +126,7 @@ ok; chomp($a = `$^X "-I../lib" "-MB::Stash" "-Mwarnings" -e1`); $a = join ',', sort split /,/, $a; -$a =~ s/-uperlio(?:::\w+)?,//g if $Config{'useperlio'} eq 'define'; +$a =~ s/-uperlio(?:::\w+)?,//g if defined $Config{'useperlio'} and $Config{'useperlio'} eq 'define'; $a =~ s/-uWin32,// if $^O eq 'MSWin32'; $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2'; $a =~ s/-uCwd,// if $^O eq 'cygwin'; diff --git a/t/op/misc.t b/t/op/misc.t index 0f10424..aea14c8 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -589,7 +589,7 @@ exit(0) unless @locales; for (@locales) { use POSIX qw(locale_h); use locale; - setlocale(LC_NUMERIC, $_) or die "setlocale(LC_NUMERIC, $_): $!"; + setlocale(LC_NUMERIC, $_) or next; my $s = sprintf "%g %g", 3.1, 3.1; next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/; print "$_ $s\n"; 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 */ -- 2.7.4