diff options
| -rw-r--r-- | embed.h | 8 | ||||
| -rw-r--r-- | lib/locale.pm | 2 | ||||
| -rw-r--r-- | op.c | 52 | ||||
| -rw-r--r-- | op.h | 4 | ||||
| -rw-r--r-- | opcode.h | 20 | ||||
| -rwxr-xr-x | opcode.pl | 20 | ||||
| -rw-r--r-- | perl.h | 19 | ||||
| -rw-r--r-- | pp.c | 26 | ||||
| -rw-r--r-- | pp.sym | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | pp_proto.h | 2 | ||||
| -rw-r--r-- | pp_sys.c | 2 | ||||
| -rwxr-xr-x | t/pragma/locale.t | 22 | ||||
| -rw-r--r-- | util.c | 2 |
14 files changed, 65 insertions, 118 deletions
@@ -1197,7 +1197,6 @@ #define ck_exit Perl_ck_exit #define ck_ftst Perl_ck_ftst #define ck_fun Perl_ck_fun -#define ck_fun_locale Perl_ck_fun_locale #define ck_glob Perl_ck_glob #define ck_grep Perl_ck_grep #define ck_index Perl_ck_index @@ -1215,7 +1214,6 @@ #define ck_rfun Perl_ck_rfun #define ck_rvconst Perl_ck_rvconst #define ck_sassign Perl_ck_sassign -#define ck_scmp Perl_ck_scmp #define ck_select Perl_ck_select #define ck_shift Perl_ck_shift #define ck_sort Perl_ck_sort @@ -2693,7 +2691,6 @@ #define ck_exit(a) Perl_ck_exit(aTHX_ a) #define ck_ftst(a) Perl_ck_ftst(aTHX_ a) #define ck_fun(a) Perl_ck_fun(aTHX_ a) -#define ck_fun_locale(a) Perl_ck_fun_locale(aTHX_ a) #define ck_glob(a) Perl_ck_glob(aTHX_ a) #define ck_grep(a) Perl_ck_grep(aTHX_ a) #define ck_index(a) Perl_ck_index(aTHX_ a) @@ -2711,7 +2708,6 @@ #define ck_rfun(a) Perl_ck_rfun(aTHX_ a) #define ck_rvconst(a) Perl_ck_rvconst(aTHX_ a) #define ck_sassign(a) Perl_ck_sassign(aTHX_ a) -#define ck_scmp(a) Perl_ck_scmp(aTHX_ a) #define ck_select(a) Perl_ck_select(aTHX_ a) #define ck_shift(a) Perl_ck_shift(aTHX_ a) #define ck_sort(a) Perl_ck_sort(aTHX_ a) @@ -5232,8 +5228,6 @@ #define ck_ftst Perl_ck_ftst #define Perl_ck_fun CPerlObj::Perl_ck_fun #define ck_fun Perl_ck_fun -#define Perl_ck_fun_locale CPerlObj::Perl_ck_fun_locale -#define ck_fun_locale Perl_ck_fun_locale #define Perl_ck_glob CPerlObj::Perl_ck_glob #define ck_glob Perl_ck_glob #define Perl_ck_grep CPerlObj::Perl_ck_grep @@ -5268,8 +5262,6 @@ #define ck_rvconst Perl_ck_rvconst #define Perl_ck_sassign CPerlObj::Perl_ck_sassign #define ck_sassign Perl_ck_sassign -#define Perl_ck_scmp CPerlObj::Perl_ck_scmp -#define ck_scmp Perl_ck_scmp #define Perl_ck_select CPerlObj::Perl_ck_select #define ck_select Perl_ck_select #define Perl_ck_shift CPerlObj::Perl_ck_shift diff --git a/lib/locale.pm b/lib/locale.pm index 3e5054c99b..a51e2b1c09 100644 --- a/lib/locale.pm +++ b/lib/locale.pm @@ -27,7 +27,7 @@ locales. =cut -$locale::hint_bits = 0x800; +$locale::hint_bits = 0x4; sub import { $^H |= $locale::hint_bits; @@ -2268,8 +2268,8 @@ Perl_fold_constants(pTHX_ register OP *o) case OP_SLE: case OP_SGE: case OP_SCMP: - - if (o->op_private & OPpLOCALE) + /* XXX what about the numeric ops? */ + if (PL_hints & HINT_LOCALE) goto nope; } @@ -5605,13 +5605,6 @@ Perl_ck_ftst(pTHX_ OP *o) else o = newUNOP(type, 0, newDEFSVOP()); } -#ifdef USE_LOCALE - if (type == OP_FTTEXT || type == OP_FTBINARY) { - o->op_private = 0; - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; - } -#endif return o; } @@ -6021,29 +6014,7 @@ Perl_ck_listiob(pTHX_ OP *o) if (!kid) append_elem(o->op_type, o, newDEFSVOP()); - o = listkids(o); - - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; -} - -OP * -Perl_ck_fun_locale(pTHX_ OP *o) -{ - o = ck_fun(o); - - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; + return listkids(o); } OP * @@ -6077,18 +6048,6 @@ Perl_ck_sassign(pTHX_ OP *o) } OP * -Perl_ck_scmp(pTHX_ OP *o) -{ - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif - - return o; -} - -OP * Perl_ck_match(pTHX_ OP *o) { o->op_private |= OPpRUNTIME; @@ -6285,11 +6244,6 @@ OP * Perl_ck_sort(pTHX_ OP *o) { OP *firstkid; - o->op_private = 0; -#ifdef USE_LOCALE - if (PL_hints & HINT_LOCALE) - o->op_private |= OPpLOCALE; -#endif if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED) simplify_sort(o); @@ -184,10 +184,6 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_EXISTS */ #define OPpEXISTS_SUB 64 /* Checking for &sub, not {} or []. */ -/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, OP_FTTEXT, OP_FTBINARY, */ -/* string comparisons, and case changers. */ -#define OPpLOCALE 64 /* Use locale */ - /* Private for OP_SORT */ #define OPpSORT_NUMERIC 1 /* Optimized away { $a <=> $b } */ #define OPpSORT_INTEGER 2 /* Ditto while under "use integer" */ @@ -1178,13 +1178,13 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_null), /* i_ne */ MEMBER_TO_FPTR(Perl_ck_null), /* ncmp */ MEMBER_TO_FPTR(Perl_ck_null), /* i_ncmp */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* slt */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* sgt */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* sle */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* sge */ + MEMBER_TO_FPTR(Perl_ck_null), /* slt */ + MEMBER_TO_FPTR(Perl_ck_null), /* sgt */ + MEMBER_TO_FPTR(Perl_ck_null), /* sle */ + MEMBER_TO_FPTR(Perl_ck_null), /* sge */ MEMBER_TO_FPTR(Perl_ck_null), /* seq */ MEMBER_TO_FPTR(Perl_ck_null), /* sne */ - MEMBER_TO_FPTR(Perl_ck_scmp), /* scmp */ + MEMBER_TO_FPTR(Perl_ck_null), /* scmp */ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_and */ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_xor */ MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_or */ @@ -1209,15 +1209,15 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { MEMBER_TO_FPTR(Perl_ck_fun), /* vec */ MEMBER_TO_FPTR(Perl_ck_index), /* index */ MEMBER_TO_FPTR(Perl_ck_index), /* rindex */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* sprintf */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sprintf */ MEMBER_TO_FPTR(Perl_ck_fun), /* formline */ MEMBER_TO_FPTR(Perl_ck_fun), /* ord */ MEMBER_TO_FPTR(Perl_ck_fun), /* chr */ MEMBER_TO_FPTR(Perl_ck_fun), /* crypt */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* ucfirst */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lcfirst */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* uc */ - MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ucfirst */ + MEMBER_TO_FPTR(Perl_ck_fun), /* lcfirst */ + MEMBER_TO_FPTR(Perl_ck_fun), /* uc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* lc */ MEMBER_TO_FPTR(Perl_ck_fun), /* quotemeta */ MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2av */ MEMBER_TO_FPTR(Perl_ck_null), /* aelemfast */ @@ -511,13 +511,13 @@ i_ne integer ne (!=) ck_null ifs2 S S ncmp numeric comparison (<=>) ck_null Iifst2 S S i_ncmp integer comparison (<=>) ck_null ifst2 S S -slt string lt ck_scmp ifs2 S S -sgt string gt ck_scmp ifs2 S S -sle string le ck_scmp ifs2 S S -sge string ge ck_scmp ifs2 S S +slt string lt ck_null ifs2 S S +sgt string gt ck_null ifs2 S S +sle string le ck_null ifs2 S S +sge string ge ck_null ifs2 S S seq string eq ck_null ifs2 S S sne string ne ck_null ifs2 S S -scmp string comparison (cmp) ck_scmp ifst2 S S +scmp string comparison (cmp) ck_null ifst2 S S bit_and bitwise and (&) ck_bitop fst2 S S bit_xor bitwise xor (^) ck_bitop fst2 S S @@ -555,15 +555,15 @@ vec vec ck_fun ist@ S S S index index ck_index isT@ S S S? rindex rindex ck_index isT@ S S S? -sprintf sprintf ck_fun_locale mfst@ S L +sprintf sprintf ck_fun mfst@ S L formline formline ck_fun ms@ S L ord ord ck_fun ifsTu% S? chr chr ck_fun fsTu% S? crypt crypt ck_fun fsT@ S S -ucfirst ucfirst ck_fun_locale fstu% S? -lcfirst lcfirst ck_fun_locale fstu% S? -uc uc ck_fun_locale fstu% S? -lc lc ck_fun_locale fstu% S? +ucfirst ucfirst ck_fun fstu% S? +lcfirst lcfirst ck_fun fstu% S? +uc uc ck_fun fstu% S? +lc lc ck_fun fstu% S? quotemeta quotemeta ck_fun fstu% S? # Arrays. @@ -2886,7 +2886,8 @@ enum { /* pass one of these to get_vtbl */ #define HINT_PRIVATE_MASK 0x000000ff #define HINT_INTEGER 0x00000001 #define HINT_STRICT_REFS 0x00000002 -/* #define HINT_notused4 0x00000004 */ +#define HINT_LOCALE 0x00000004 +#define HINT_BYTES 0x00000008 #define HINT_BYTES 0x00000008 /* #define HINT_notused10 0x00000010 */ /* Note: 20,40,80 used for NATIVE_HINTS */ @@ -2894,7 +2895,6 @@ enum { /* pass one of these to get_vtbl */ #define HINT_BLOCK_SCOPE 0x00000100 #define HINT_STRICT_SUBS 0x00000200 #define HINT_STRICT_VARS 0x00000400 -#define HINT_LOCALE 0x00000800 #define HINT_NEW_INTEGER 0x00001000 #define HINT_NEW_FLOAT 0x00002000 @@ -3428,16 +3428,23 @@ typedef struct am_table_short AMTS; #define SET_NUMERIC_LOCAL() \ set_numeric_local(); +#define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) +#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) + +#define IN_LOCALE \ + (PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) + #define IS_NUMERIC_RADIX(s) \ - ((PL_hints & HINT_LOCALE) && \ - PL_numeric_radix_sv && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))) + (PL_numeric_radix_sv \ + && IN_LOCALE \ + && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv))) #define STORE_NUMERIC_LOCAL_SET_STANDARD() \ - bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \ + bool was_local = PL_numeric_local && IN_LOCALE; \ if (was_local) SET_NUMERIC_STANDARD(); #define STORE_NUMERIC_STANDARD_SET_LOCAL() \ - bool was_standard = (PL_hints & HINT_LOCALE) && PL_numeric_standard; \ + bool was_standard = PL_numeric_standard && IN_LOCALE; \ if (was_standard) SET_NUMERIC_LOCAL(); #define RESTORE_NUMERIC_LOCAL() \ @@ -1911,7 +1911,7 @@ PP(pp_slt) dSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp < 0)); @@ -1924,7 +1924,7 @@ PP(pp_sgt) dSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp > 0)); @@ -1937,7 +1937,7 @@ PP(pp_sle) dSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp <= 0)); @@ -1950,7 +1950,7 @@ PP(pp_sge) dSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETs(boolSV(cmp >= 0)); @@ -1983,7 +1983,7 @@ PP(pp_scmp) dSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; - int cmp = ((PL_op->op_private & OPpLOCALE) + int cmp = (IN_LOCALE_RUNTIME ? sv_cmp_locale(left, right) : sv_cmp(left, right)); SETi( cmp ); @@ -3054,7 +3054,7 @@ PP(pp_ucfirst) U8 *tend; UV uv; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0)); @@ -3086,7 +3086,7 @@ PP(pp_ucfirst) } s = (U8*)SvPV_force(sv, slen); if (*s) { - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); *s = toUPPER_LC(*s); @@ -3113,7 +3113,7 @@ PP(pp_lcfirst) U8 *tend; UV uv; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0)); @@ -3145,7 +3145,7 @@ PP(pp_lcfirst) } s = (U8*)SvPV_force(sv, slen); if (*s) { - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); *s = toLOWER_LC(*s); @@ -3184,7 +3184,7 @@ PP(pp_uc) (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(TARG); while (s < send) { @@ -3216,7 +3216,7 @@ PP(pp_uc) if (len) { register U8 *send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); for (; s < send; s++) @@ -3258,7 +3258,7 @@ PP(pp_lc) (void)SvPOK_only(TARG); d = (U8*)SvPVX(TARG); send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(TARG); while (s < send) { @@ -3291,7 +3291,7 @@ PP(pp_lc) if (len) { register U8 *send = s + len; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); for (; s < send; s++) @@ -16,7 +16,6 @@ Perl_ck_exists Perl_ck_exit Perl_ck_ftst Perl_ck_fun -Perl_ck_fun_locale Perl_ck_glob Perl_ck_grep Perl_ck_index @@ -34,7 +33,6 @@ Perl_ck_return Perl_ck_rfun Perl_ck_rvconst Perl_ck_sassign -Perl_ck_scmp Perl_ck_select Perl_ck_shift Perl_ck_sort @@ -1031,7 +1031,7 @@ PP(pp_sort) ? ( (PL_op->op_private & OPpSORT_INTEGER) ? ( overloading ? amagic_i_ncmp : sv_i_ncmp) : ( overloading ? amagic_ncmp : sv_ncmp)) - : ( (PL_op->op_private & OPpLOCALE) + : ( IN_LOCALE_RUNTIME ? ( overloading ? amagic_cmp_locale : sv_cmp_locale_static) diff --git a/pp_proto.h b/pp_proto.h index d6d626fc89..86ab4c2550 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -15,7 +15,6 @@ PERL_CKDEF(Perl_ck_exists) PERL_CKDEF(Perl_ck_exit) PERL_CKDEF(Perl_ck_ftst) PERL_CKDEF(Perl_ck_fun) -PERL_CKDEF(Perl_ck_fun_locale) PERL_CKDEF(Perl_ck_glob) PERL_CKDEF(Perl_ck_grep) PERL_CKDEF(Perl_ck_index) @@ -33,7 +32,6 @@ PERL_CKDEF(Perl_ck_return) PERL_CKDEF(Perl_ck_rfun) PERL_CKDEF(Perl_ck_rvconst) PERL_CKDEF(Perl_ck_sassign) -PERL_CKDEF(Perl_ck_scmp) PERL_CKDEF(Perl_ck_select) PERL_CKDEF(Perl_ck_shift) PERL_CKDEF(Perl_ck_sort) @@ -3300,7 +3300,7 @@ PP(pp_fttext) #else else if (*s & 128) { #ifdef USE_LOCALE - if ((PL_op->op_private & OPpLOCALE) && isALPHA_LC(*s)) + if (IN_LOCALE_RUNTIME && isALPHA_LC(*s)) continue; #endif /* utf8 characters don't count as odd */ diff --git a/t/pragma/locale.t b/t/pragma/locale.t index bcb5fa205c..e0c833093d 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -9,6 +9,7 @@ BEGIN { print "1..0\n"; exit; } + $| = 1; } use strict; @@ -651,7 +652,7 @@ foreach $Locale (@Locale) { tryneoalpha($Locale, 107, $c == $d); { - no locale; +# no locale; # XXX did this ever work correctly? my $e = "$x"; @@ -816,16 +817,17 @@ if ($didwarn) { warn "# None of your locales were broken.\n"; } - if (@utf8locale) { - my $S = join(" ", @utf8locale); - $S =~ s/(.{50,60}) /$1\n#\t/g; +} + +if (@utf8locale) { + my $S = join(" ", @utf8locale); + $S =~ s/(.{50,60}) /$1\n#\t/g; - warn "# The following locales\n#\n", - "#\t", $S, "\n#\n", - "# were skipped for the tests ", - join(" ", sort {$a<=>$b} keys %utf8skip), "\n", - "# because UTF-8 and locales do not work together in Perl.\n#\n"; - } + warn "#\n# The following locales\n#\n", + "#\t", $S, "\n#\n", + "# were skipped for the tests ", + join(" ", sort {$a<=>$b} keys %utf8skip), "\n", + "# because UTF-8 and locales do not work together in Perl.\n#\n"; } # eof @@ -4015,7 +4015,7 @@ Perl_my_atof(pTHX_ const char* s) { NV x = 0.0; #ifdef USE_LOCALE_NUMERIC - if ((PL_hints & HINT_LOCALE) && PL_numeric_local) { + if (PL_numeric_local && IN_LOCALE) { NV y; Perl_atof2(aTHX_ s, &x); |