X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=ebdf3fd98dbcc72b78a021413135067d30015604;hb=7b57b0ead8ab6b3f08be8b4ded2364d260db25a1;hp=ae2ff93ad6953385291e8933c876486762b36c00;hpb=b82d478d407f1381d69179104035c975c1d1402e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index ae2ff93..ebdf3fd 100644 --- a/pp.c +++ b/pp.c @@ -92,7 +92,7 @@ extern Pid_t getpid (void); PP(pp_stub) { - djSP; + dSP; if (GIMME_V == G_SCALAR) XPUSHs(&PL_sv_undef); RETURN; @@ -107,7 +107,7 @@ PP(pp_scalar) PP(pp_padav) { - djSP; dTARGET; + dSP; dTARGET; if (PL_op->op_private & OPpLVAL_INTRO) SAVECLEARSV(PL_curpad[PL_op->op_targ]); EXTEND(SP, 1); @@ -146,7 +146,7 @@ PP(pp_padav) PP(pp_padhv) { - djSP; dTARGET; + dSP; dTARGET; I32 gimme; XPUSHs(TARG); @@ -184,7 +184,7 @@ PP(pp_padany) PP(pp_rv2gv) { - djSP; dTOPss; + dSP; dTOPss; if (SvROK(sv)) { wasref: @@ -270,7 +270,7 @@ PP(pp_rv2gv) PP(pp_rv2sv) { - djSP; dTOPss; + dSP; dTOPss; if (SvROK(sv)) { wasref: @@ -335,13 +335,13 @@ PP(pp_rv2sv) PP(pp_av2arylen) { - djSP; + dSP; AV *av = (AV*)TOPs; SV *sv = AvARYLEN(av); if (!sv) { AvARYLEN(av) = sv = NEWSV(0,0); sv_upgrade(sv, SVt_IV); - sv_magic(sv, (SV*)av, '#', Nullch, 0); + sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0); } SETs(sv); RETURN; @@ -349,12 +349,12 @@ PP(pp_av2arylen) PP(pp_pos) { - djSP; dTARGET; dPOPss; + dSP; dTARGET; dPOPss; if (PL_op->op_flags & OPf_MOD || LVRET) { if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, '.', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0); } LvTYPE(TARG) = '.'; @@ -370,7 +370,7 @@ PP(pp_pos) MAGIC* mg; if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - mg = mg_find(sv, 'g'); + mg = mg_find(sv, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { I32 i = mg->mg_len; if (DO_UTF8(sv)) @@ -385,7 +385,7 @@ PP(pp_pos) PP(pp_rv2cv) { - djSP; + dSP; GV *gv; HV *stash; @@ -410,7 +410,7 @@ PP(pp_rv2cv) PP(pp_prototype) { - djSP; + dSP; CV *cv; HV *stash; GV *gv; @@ -448,10 +448,12 @@ PP(pp_prototype) else if (n && str[0] == ';' && seen_question) goto set; /* XXXX system, exec */ if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF - && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) { + && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF + /* But globs are already references (kinda) */ + && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF + ) { str[n++] = '\\'; } - /* What to do with R ((un)tie, tied, (sys)read, recv)? */ str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)]; oa = oa >> 4; } @@ -476,7 +478,7 @@ PP(pp_prototype) PP(pp_anoncode) { - djSP; + dSP; CV* cv = (CV*)PL_curpad[PL_op->op_targ]; if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); @@ -487,14 +489,14 @@ PP(pp_anoncode) PP(pp_srefgen) { - djSP; + dSP; *SP = refto(*SP); RETURN; } PP(pp_refgen) { - djSP; dMARK; + dSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; @@ -544,7 +546,7 @@ S_refto(pTHX_ SV *sv) PP(pp_ref) { - djSP; dTARGET; + dSP; dTARGET; SV *sv; char *pv; @@ -564,7 +566,7 @@ PP(pp_ref) PP(pp_bless) { - djSP; + dSP; HV *stash; if (MAXARG == 1) @@ -593,7 +595,7 @@ PP(pp_gelem) SV *sv; SV *tmpRef; char *elem; - djSP; + dSP; STRLEN n_a; sv = POPs; @@ -657,7 +659,7 @@ PP(pp_gelem) PP(pp_study) { - djSP; dPOPss; + dSP; dPOPss; register unsigned char *s; register I32 pos; register I32 ch; @@ -713,13 +715,14 @@ PP(pp_study) } SvSCREAM_on(sv); - sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */ + /* piggyback on m//g magic */ + sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0); RETPUSHYES; } PP(pp_trans) { - djSP; dTARG; + dSP; dTARG; SV *sv; if (PL_op->op_flags & OPf_STACKED) @@ -737,7 +740,7 @@ PP(pp_trans) PP(pp_schop) { - djSP; dTARGET; + dSP; dTARGET; do_chop(TARG, TOPs); SETTARG; RETURN; @@ -745,23 +748,24 @@ PP(pp_schop) PP(pp_chop) { - djSP; dMARK; dTARGET; - while (SP > MARK) - do_chop(TARG, POPs); + dSP; dMARK; dTARGET; dORIGMARK; + while (MARK < SP) + do_chop(TARG, *++MARK); + SP = ORIGMARK; PUSHTARG; RETURN; } PP(pp_schomp) { - djSP; dTARGET; + dSP; dTARGET; SETi(do_chomp(TOPs)); RETURN; } PP(pp_chomp) { - djSP; dMARK; dTARGET; + dSP; dMARK; dTARGET; register I32 count = 0; while (SP > MARK) @@ -772,7 +776,7 @@ PP(pp_chomp) PP(pp_defined) { - djSP; + dSP; register SV* sv; sv = POPs; @@ -780,11 +784,13 @@ PP(pp_defined) RETPUSHNO; switch (SvTYPE(sv)) { case SVt_PVAV: - if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) + || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) RETPUSHYES; break; case SVt_PVHV: - if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) + if (HvARRAY(sv) || SvGMAGICAL(sv) + || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) RETPUSHYES; break; case SVt_PVCV: @@ -802,7 +808,7 @@ PP(pp_defined) PP(pp_undef) { - djSP; + dSP; SV *sv; if (!PL_op->op_private) { @@ -834,7 +840,7 @@ PP(pp_undef) case SVt_PVFM: { /* let user-undef'd sub keep its identity */ - GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); + GV* gv = CvGV((CV*)sv); cv_undef((CV*)sv); CvGV((CV*)sv) = gv; } @@ -869,7 +875,7 @@ PP(pp_undef) PP(pp_predec) { - djSP; + dSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -886,7 +892,7 @@ PP(pp_predec) PP(pp_postinc) { - djSP; dTARGET; + dSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -907,7 +913,7 @@ PP(pp_postinc) PP(pp_postdec) { - djSP; dTARGET; + dSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -928,7 +934,7 @@ PP(pp_postdec) PP(pp_pow) { - djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); + dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); { dPOPTOPnnrl; SETn( Perl_pow( left, right) ); @@ -938,7 +944,7 @@ PP(pp_pow) PP(pp_multiply) { - djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1056,7 +1062,7 @@ PP(pp_multiply) PP(pp_divide) { - djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + dSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPPOPnnrl; NV value; @@ -1085,15 +1091,15 @@ PP(pp_divide) PP(pp_modulo) { - djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { - UV left; - UV right; + UV left = 0; + UV right = 0; bool left_neg; bool right_neg; bool use_double = 0; - NV dright; - NV dleft; + NV dright = 0.0; + NV dleft = 0.0; if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); @@ -1185,7 +1191,7 @@ PP(pp_modulo) PP(pp_repeat) { - djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); + dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); { register IV count = POPi; if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { @@ -1231,6 +1237,16 @@ PP(pp_repeat) (void)SvPOK_only_UTF8(TARG); else (void)SvPOK_only(TARG); + + if (PL_op->op_private & OPpREPEAT_DOLIST) { + /* The parser saw this as a list repeat, and there + are probably several items on the stack. But we're + in scalar context, and there's no pp_list to save us + now. So drop the rest of the items -- robin@kitsite.com + */ + dMARK; + SP = MARK; + } PUSHTARG; } RETURN; @@ -1239,7 +1255,7 @@ PP(pp_repeat) PP(pp_subtract) { - djSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN); + dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN); useleft = USE_LEFT(TOPm1s); #ifdef PERL_PRESERVE_IVUV /* See comments in pp_add (in pp_hot.c) about Overflow, and how @@ -1249,8 +1265,8 @@ PP(pp_subtract) /* Unless the left argument is integer in range we are going to have to use NV maths. Hence only attempt to coerce the right argument if we know the left is integer. */ - register UV auv; - bool auvok; + register UV auv = 0; + bool auvok = FALSE; bool a_valid = 0; if (!useleft) { @@ -1280,7 +1296,7 @@ PP(pp_subtract) UV result; register UV buv; bool buvok = SvUOK(TOPs); - + if (buvok) buv = SvUVX(TOPs); else { @@ -1356,7 +1372,7 @@ PP(pp_subtract) PP(pp_left_shift) { - djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1373,7 +1389,7 @@ PP(pp_left_shift) PP(pp_right_shift) { - djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1390,7 +1406,7 @@ PP(pp_right_shift) PP(pp_lt) { - djSP; tryAMAGICbinSET(lt,0); + dSP; tryAMAGICbinSET(lt,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1468,7 +1484,7 @@ PP(pp_lt) PP(pp_gt) { - djSP; tryAMAGICbinSET(gt,0); + dSP; tryAMAGICbinSET(gt,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1546,7 +1562,7 @@ PP(pp_gt) PP(pp_le) { - djSP; tryAMAGICbinSET(le,0); + dSP; tryAMAGICbinSET(le,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1624,7 +1640,7 @@ PP(pp_le) PP(pp_ge) { - djSP; tryAMAGICbinSET(ge,0); + dSP; tryAMAGICbinSET(ge,0); #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1702,7 +1718,13 @@ PP(pp_ge) PP(pp_ne) { - djSP; tryAMAGICbinSET(ne,0); + dSP; tryAMAGICbinSET(ne,0); +#ifndef NV_PRESERVES_UV + if (SvROK(TOPs) && SvROK(TOPm1s)) { + SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s))); + RETURN; + } +#endif #ifdef PERL_PRESERVE_IVUV SvIV_please(TOPs); if (SvIOK(TOPs)) { @@ -1772,7 +1794,13 @@ PP(pp_ne) PP(pp_ncmp) { - djSP; dTARGET; tryAMAGICbin(ncmp,0); + dSP; dTARGET; tryAMAGICbin(ncmp,0); +#ifndef NV_PRESERVES_UV + if (SvROK(TOPs) && SvROK(TOPm1s)) { + SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s))); + RETURN; + } +#endif #ifdef PERL_PRESERVE_IVUV /* Fortunately it seems NaN isn't IOK */ SvIV_please(TOPs); @@ -1880,10 +1908,10 @@ PP(pp_ncmp) PP(pp_slt) { - djSP; tryAMAGICbinSET(slt,0); + 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)); @@ -1893,10 +1921,10 @@ PP(pp_slt) PP(pp_sgt) { - djSP; tryAMAGICbinSET(sgt,0); + 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)); @@ -1906,10 +1934,10 @@ PP(pp_sgt) PP(pp_sle) { - djSP; tryAMAGICbinSET(sle,0); + 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)); @@ -1919,10 +1947,10 @@ PP(pp_sle) PP(pp_sge) { - djSP; tryAMAGICbinSET(sge,0); + 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)); @@ -1932,7 +1960,7 @@ PP(pp_sge) PP(pp_seq) { - djSP; tryAMAGICbinSET(seq,0); + dSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; SETs(boolSV(sv_eq(left, right))); @@ -1942,7 +1970,7 @@ PP(pp_seq) PP(pp_sne) { - djSP; tryAMAGICbinSET(sne,0); + dSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; SETs(boolSV(!sv_eq(left, right))); @@ -1952,10 +1980,10 @@ PP(pp_sne) PP(pp_scmp) { - djSP; dTARGET; tryAMAGICbin(scmp,0); + 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 ); @@ -1965,7 +1993,7 @@ PP(pp_scmp) PP(pp_bit_and) { - djSP; dATARGET; tryAMAGICbin(band,opASSIGN); + dSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1988,7 +2016,7 @@ PP(pp_bit_and) PP(pp_bit_xor) { - djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -2011,7 +2039,7 @@ PP(pp_bit_xor) PP(pp_bit_or) { - djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -2034,7 +2062,7 @@ PP(pp_bit_or) PP(pp_negate) { - djSP; dTARGET; tryAMAGICun(neg); + dSP; dTARGET; tryAMAGICun(neg); { dTOPss; int flags = SvFLAGS(sv); @@ -2098,14 +2126,14 @@ PP(pp_negate) PP(pp_not) { - djSP; tryAMAGICunSET(not); + dSP; tryAMAGICunSET(not); *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); return NORMAL; } PP(pp_complement) { - djSP; dTARGET; tryAMAGICun(compl); + dSP; dTARGET; tryAMAGICun(compl); { dTOPss; if (SvNIOKp(sv)) { @@ -2137,7 +2165,7 @@ PP(pp_complement) send = tmps + len; while (tmps < send) { - UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); + UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); tmps += UTF8SKIP(tmps); targlen += UNISKIP(~c); nchar++; @@ -2151,9 +2179,9 @@ PP(pp_complement) if (nwide) { Newz(0, result, targlen + 1, U8); while (tmps < send) { - UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); + UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); tmps += UTF8SKIP(tmps); - result = uv_to_utf8(result, ~c); + result = uvchr_to_utf8(result, ~c); } *result = '\0'; result -= targlen; @@ -2163,7 +2191,7 @@ PP(pp_complement) else { Newz(0, result, nchar + 1, U8); while (tmps < send) { - U8 c = (U8)utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY); + U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY); tmps += UTF8SKIP(tmps); *result++ = ~c; } @@ -2199,7 +2227,7 @@ PP(pp_complement) PP(pp_i_multiply) { - djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPiirl; SETi( left * right ); @@ -2209,7 +2237,7 @@ PP(pp_i_multiply) PP(pp_i_divide) { - djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + dSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPiv; if (value == 0) @@ -2222,7 +2250,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -2234,7 +2262,7 @@ PP(pp_i_modulo) PP(pp_i_add) { - djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + dSP; dATARGET; tryAMAGICbin(add,opASSIGN); { dPOPTOPiirl_ul; SETi( left + right ); @@ -2244,7 +2272,7 @@ PP(pp_i_add) PP(pp_i_subtract) { - djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPiirl_ul; SETi( left - right ); @@ -2254,7 +2282,7 @@ PP(pp_i_subtract) PP(pp_i_lt) { - djSP; tryAMAGICbinSET(lt,0); + dSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; SETs(boolSV(left < right)); @@ -2264,7 +2292,7 @@ PP(pp_i_lt) PP(pp_i_gt) { - djSP; tryAMAGICbinSET(gt,0); + dSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; SETs(boolSV(left > right)); @@ -2274,7 +2302,7 @@ PP(pp_i_gt) PP(pp_i_le) { - djSP; tryAMAGICbinSET(le,0); + dSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; SETs(boolSV(left <= right)); @@ -2284,7 +2312,7 @@ PP(pp_i_le) PP(pp_i_ge) { - djSP; tryAMAGICbinSET(ge,0); + dSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; SETs(boolSV(left >= right)); @@ -2294,7 +2322,7 @@ PP(pp_i_ge) PP(pp_i_eq) { - djSP; tryAMAGICbinSET(eq,0); + dSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; SETs(boolSV(left == right)); @@ -2304,7 +2332,7 @@ PP(pp_i_eq) PP(pp_i_ne) { - djSP; tryAMAGICbinSET(ne,0); + dSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; SETs(boolSV(left != right)); @@ -2314,7 +2342,7 @@ PP(pp_i_ne) PP(pp_i_ncmp) { - djSP; dTARGET; tryAMAGICbin(ncmp,0); + dSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPiirl; I32 value; @@ -2332,7 +2360,7 @@ PP(pp_i_ncmp) PP(pp_i_negate) { - djSP; dTARGET; tryAMAGICun(neg); + dSP; dTARGET; tryAMAGICun(neg); SETi(-TOPi); RETURN; } @@ -2341,7 +2369,7 @@ PP(pp_i_negate) PP(pp_atan2) { - djSP; dTARGET; tryAMAGICbin(atan2,0); + dSP; dTARGET; tryAMAGICbin(atan2,0); { dPOPTOPnnrl; SETn(Perl_atan2(left, right)); @@ -2351,7 +2379,7 @@ PP(pp_atan2) PP(pp_sin) { - djSP; dTARGET; tryAMAGICun(sin); + dSP; dTARGET; tryAMAGICun(sin); { NV value; value = POPn; @@ -2363,7 +2391,7 @@ PP(pp_sin) PP(pp_cos) { - djSP; dTARGET; tryAMAGICun(cos); + dSP; dTARGET; tryAMAGICun(cos); { NV value; value = POPn; @@ -2390,7 +2418,7 @@ extern double drand48 (void); PP(pp_rand) { - djSP; dTARGET; + dSP; dTARGET; NV value; if (MAXARG < 1) value = 1.0; @@ -2409,7 +2437,7 @@ PP(pp_rand) PP(pp_srand) { - djSP; + dSP; UV anum; if (MAXARG < 1) anum = seed(); @@ -2504,7 +2532,7 @@ S_seed(pTHX) PP(pp_exp) { - djSP; dTARGET; tryAMAGICun(exp); + dSP; dTARGET; tryAMAGICun(exp); { NV value; value = POPn; @@ -2516,7 +2544,7 @@ PP(pp_exp) PP(pp_log) { - djSP; dTARGET; tryAMAGICun(log); + dSP; dTARGET; tryAMAGICun(log); { NV value; value = POPn; @@ -2532,7 +2560,7 @@ PP(pp_log) PP(pp_sqrt) { - djSP; dTARGET; tryAMAGICun(sqrt); + dSP; dTARGET; tryAMAGICun(sqrt); { NV value; value = POPn; @@ -2548,7 +2576,7 @@ PP(pp_sqrt) PP(pp_int) { - djSP; dTARGET; tryAMAGICun(int); + dSP; dTARGET; tryAMAGICun(int); { NV value; IV iv = TOPi; /* attempt to convert to IV if possible. */ @@ -2570,7 +2598,16 @@ PP(pp_int) SETu(U_V(value)); } else { #if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE) +# ifdef HAS_MODFL_POW32_BUG +/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */ + { + NV offset = Perl_modf(value, &value); + (void)Perl_modf(offset, &offset); + value += offset; + } +# else (void)Perl_modf(value, &value); +# endif #else double tmp = (double)value; (void)Perl_modf(tmp, &tmp); @@ -2584,7 +2621,16 @@ PP(pp_int) SETi(I_V(value)); } else { #if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE) +# ifdef HAS_MODFL_POW32_BUG +/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */ + { + NV offset = Perl_modf(-value, &value); + (void)Perl_modf(offset, &offset); + value += offset; + } +# else (void)Perl_modf(-value, &value); +# endif value = -value; #else double tmp = (double)value; @@ -2601,7 +2647,7 @@ PP(pp_int) PP(pp_abs) { - djSP; dTARGET; tryAMAGICun(abs); + dSP; dTARGET; tryAMAGICun(abs); { /* This will cache the NV value if string isn't actually integer */ IV iv = TOPi; @@ -2635,37 +2681,37 @@ PP(pp_abs) PP(pp_hex) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; STRLEN argtype; - STRLEN n_a; + STRLEN len; - tmps = POPpx; + tmps = (SvPVx(POPs, len)); argtype = 1; /* allow underscores */ - XPUSHn(scan_hex(tmps, 99, &argtype)); + XPUSHn(scan_hex(tmps, len, &argtype)); RETURN; } PP(pp_oct) { - djSP; dTARGET; + dSP; dTARGET; NV value; STRLEN argtype; char *tmps; - STRLEN n_a; + STRLEN len; - tmps = POPpx; - while (*tmps && isSPACE(*tmps)) - tmps++; + tmps = (SvPVx(POPs, len)); + while (*tmps && len && isSPACE(*tmps)) + tmps++, len--; if (*tmps == '0') - tmps++; + tmps++, len--; argtype = 1; /* allow underscores */ if (*tmps == 'x') - value = scan_hex(++tmps, 99, &argtype); + value = scan_hex(++tmps, --len, &argtype); else if (*tmps == 'b') - value = scan_bin(++tmps, 99, &argtype); + value = scan_bin(++tmps, --len, &argtype); else - value = scan_oct(tmps, 99, &argtype); + value = scan_oct(tmps, len, &argtype); XPUSHn(value); RETURN; } @@ -2674,7 +2720,7 @@ PP(pp_oct) PP(pp_length) { - djSP; dTARGET; + dSP; dTARGET; SV *sv = TOPs; if (DO_UTF8(sv)) @@ -2686,43 +2732,55 @@ PP(pp_length) PP(pp_substr) { - djSP; dTARGET; + dSP; dTARGET; SV *sv; - I32 len; + I32 len = 0; STRLEN curlen; - STRLEN utfcurlen; + STRLEN utf8_curlen; I32 pos; I32 rem; I32 fail; I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; char *tmps; I32 arybase = PL_curcop->cop_arybase; + SV *repl_sv = NULL; char *repl = 0; STRLEN repl_len; int num_args = PL_op->op_private & 7; + bool repl_need_utf8_upgrade = FALSE; + bool repl_is_utf8 = FALSE; SvTAINTED_off(TARG); /* decontaminate */ SvUTF8_off(TARG); /* decontaminate */ if (num_args > 2) { if (num_args > 3) { - sv = POPs; - repl = SvPV(sv, repl_len); + repl_sv = POPs; + repl = SvPV(repl_sv, repl_len); + repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv); } len = POPi; } pos = POPi; sv = POPs; PUTBACK; + if (repl_sv) { + if (repl_is_utf8) { + if (!DO_UTF8(sv)) + sv_utf8_upgrade(sv); + } + else if (DO_UTF8(sv)) + repl_need_utf8_upgrade = TRUE; + } tmps = SvPV(sv, curlen); if (DO_UTF8(sv)) { - utfcurlen = sv_len_utf8(sv); - if (utfcurlen == curlen) - utfcurlen = 0; + utf8_curlen = sv_len_utf8(sv); + if (utf8_curlen == curlen) + utf8_curlen = 0; else - curlen = utfcurlen; + curlen = utf8_curlen; } else - utfcurlen = 0; + utf8_curlen = 0; if (pos >= arybase) { pos -= arybase; @@ -2767,14 +2825,30 @@ PP(pp_substr) else { I32 upos = pos; I32 urem = rem; - if (utfcurlen) + if (utf8_curlen) sv_pos_u2b(sv, &pos, &rem); tmps += pos; sv_setpvn(TARG, tmps, rem); - if (utfcurlen) +#ifdef USE_LOCALE_COLLATE + sv_unmagic(TARG, PERL_MAGIC_collxfrm); +#endif + if (utf8_curlen) SvUTF8_on(TARG); - if (repl) + if (repl) { + SV* repl_sv_copy = NULL; + + if (repl_need_utf8_upgrade) { + repl_sv_copy = newSVsv(repl_sv); + sv_utf8_upgrade(repl_sv_copy); + repl = SvPV(repl_sv_copy, repl_len); + repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv); + } sv_insert(sv, pos, rem, repl, repl_len); + if (repl_is_utf8) + SvUTF8_on(sv); + if (repl_sv_copy) + SvREFCNT_dec(repl_sv_copy); + } else if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { if (SvROK(sv)) { @@ -2792,7 +2866,7 @@ PP(pp_substr) if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, 'x', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); } LvTYPE(TARG) = 'x'; @@ -2812,7 +2886,7 @@ PP(pp_substr) PP(pp_vec) { - djSP; dTARGET; + dSP; dTARGET; register IV size = POPi; register IV offset = POPi; register SV *src = POPs; @@ -2822,7 +2896,7 @@ PP(pp_vec) if (lvalue) { /* it's an lvalue! */ if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, 'v', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0); } LvTYPE(TARG) = 'v'; if (LvTARG(TARG) != src) { @@ -2841,7 +2915,7 @@ PP(pp_vec) PP(pp_index) { - djSP; dTARGET; + dSP; dTARGET; SV *big; SV *little; I32 offset; @@ -2877,7 +2951,7 @@ PP(pp_index) PP(pp_rindex) { - djSP; dTARGET; + dSP; dTARGET; SV *big; SV *little; STRLEN blen; @@ -2918,7 +2992,7 @@ PP(pp_rindex) PP(pp_sprintf) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; do_sprintf(TARG, SP-MARK, MARK+1); TAINT_IF(SvTAINTED(TARG)); SP = ORIGMARK; @@ -2928,26 +3002,26 @@ PP(pp_sprintf) PP(pp_ord) { - djSP; dTARGET; + dSP; dTARGET; SV *argsv = POPs; STRLEN len; U8 *s = (U8*)SvPVx(argsv, len); - XPUSHu(DO_UTF8(argsv) ? utf8_to_uv_simple(s, 0) : (*s & 0xff)); + XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff)); RETURN; } PP(pp_chr) { - djSP; dTARGET; + dSP; dTARGET; char *tmps; UV value = POPu; (void)SvUPGRADE(TARG,SVt_PV); - if (value > 255 && !IN_BYTE) { + if (value > 255 && !IN_BYTES) { SvGROW(TARG, UNISKIP(value)+1); - tmps = (char*)uv_to_utf8((U8*)SvPVX(TARG), value); + tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value); SvCUR_set(TARG, tmps - SvPVX(TARG)); *tmps = '\0'; (void)SvPOK_only(TARG); @@ -2968,7 +3042,7 @@ PP(pp_chr) PP(pp_crypt) { - djSP; dTARGET; dPOPTOPssrl; + dSP; dTARGET; dPOPTOPssrl; STRLEN n_a; #ifdef HAS_CRYPT char *tmps = SvPV(left, n_a); @@ -2987,7 +3061,7 @@ PP(pp_crypt) PP(pp_ucfirst) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN slen; @@ -2996,17 +3070,17 @@ PP(pp_ucfirst) STRLEN ulen; U8 tmpbuf[UTF8_MAXLEN+1]; U8 *tend; - UV uv = utf8_to_uv(s, slen, &ulen, 0); + UV uv; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); - uv = toTITLE_LC_uni(uv); + uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0)); } else uv = toTITLE_utf8(s); - tend = uv_to_utf8(tmpbuf, uv); + tend = uvchr_to_utf8(tmpbuf, uv); if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { dTARGET; @@ -3030,7 +3104,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); @@ -3046,7 +3120,7 @@ PP(pp_ucfirst) PP(pp_lcfirst) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN slen; @@ -3055,17 +3129,17 @@ PP(pp_lcfirst) STRLEN ulen; U8 tmpbuf[UTF8_MAXLEN+1]; U8 *tend; - UV uv = utf8_to_uv(s, slen, &ulen, 0); + UV uv; - if (PL_op->op_private & OPpLOCALE) { + if (IN_LOCALE_RUNTIME) { TAINT; SvTAINTED_on(sv); - uv = toLOWER_LC_uni(uv); + uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0)); } else uv = toLOWER_utf8(s); - tend = uv_to_utf8(tmpbuf, uv); + tend = uvchr_to_utf8(tmpbuf, uv); if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { dTARGET; @@ -3089,7 +3163,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); @@ -3105,7 +3179,7 @@ PP(pp_lcfirst) PP(pp_uc) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN len; @@ -3128,17 +3202,17 @@ 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) { - d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, len, &ulen, 0))); + d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0))); s += ulen; } } else { while (s < send) { - d = uv_to_utf8(d, toUPPER_utf8( s )); + d = uvchr_to_utf8(d, toUPPER_utf8( s )); s += UTF8SKIP(s); } } @@ -3160,7 +3234,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++) @@ -3179,7 +3253,7 @@ PP(pp_uc) PP(pp_lc) { - djSP; + dSP; SV *sv = TOPs; register U8 *s; STRLEN len; @@ -3202,17 +3276,17 @@ 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) { - d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, len, &ulen, 0))); + d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0))); s += ulen; } } else { while (s < send) { - d = uv_to_utf8(d, toLOWER_utf8(s)); + d = uvchr_to_utf8(d, toLOWER_utf8(s)); s += UTF8SKIP(s); } } @@ -3235,7 +3309,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++) @@ -3254,7 +3328,7 @@ PP(pp_lc) PP(pp_quotemeta) { - djSP; dTARGET; + dSP; dTARGET; SV *sv = TOPs; STRLEN len; register char *s = SvPV(sv,len); @@ -3307,7 +3381,7 @@ PP(pp_quotemeta) PP(pp_aslice) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register SV** svp; register AV* av = (AV*)POPs; register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); @@ -3352,7 +3426,7 @@ PP(pp_aslice) PP(pp_each) { - djSP; + dSP; HV *hash = (HV*)POPs; HE *entry; I32 gimme = GIMME_V; @@ -3394,7 +3468,7 @@ PP(pp_keys) PP(pp_delete) { - djSP; + dSP; I32 gimme = GIMME_V; I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; @@ -3458,7 +3532,7 @@ PP(pp_delete) PP(pp_exists) { - djSP; + dSP; SV *tmpsv; HV *hv; @@ -3495,7 +3569,7 @@ PP(pp_exists) PP(pp_hslice) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register HV *hv = (HV*)POPs; register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); I32 realhv = (SvTYPE(hv) == SVt_PVHV); @@ -3507,7 +3581,9 @@ PP(pp_hslice) while (++MARK <= SP) { SV *keysv = *MARK; SV **svp; - I32 preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0); + I32 preeminent = SvRMAGICAL(hv) ? 1 : + realhv ? hv_exists_ent(hv, keysv, 0) + : avhv_exists_ent((AV*)hv, keysv, 0); if (realhv) { HE *he = hv_fetch_ent(hv, keysv, lval, 0); svp = he ? &HeVAL(he) : 0; @@ -3545,7 +3621,7 @@ PP(pp_hslice) PP(pp_list) { - djSP; dMARK; + dSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; /* unwanted list, return last item */ @@ -3558,7 +3634,7 @@ PP(pp_list) PP(pp_lslice) { - djSP; + dSP; SV **lastrelem = PL_stack_sp; SV **lastlelem = PL_stack_base + POPMARK; SV **firstlelem = PL_stack_base + POPMARK + 1; @@ -3613,7 +3689,7 @@ PP(pp_lslice) PP(pp_anonlist) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; I32 items = SP - MARK; SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); SP = ORIGMARK; /* av_make() might realloc stack_sp */ @@ -3623,7 +3699,7 @@ PP(pp_anonlist) PP(pp_anonhash) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; HV* hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -3642,7 +3718,7 @@ PP(pp_anonhash) PP(pp_splice) { - djSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; register AV *ary = (AV*)*++MARK; register SV **src; register SV **dst; @@ -3655,7 +3731,7 @@ PP(pp_splice) SV **tmparyval = 0; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -3844,12 +3920,12 @@ PP(pp_splice) PP(pp_push) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv = &PL_sv_undef; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -3874,7 +3950,7 @@ PP(pp_push) PP(pp_pop) { - djSP; + dSP; AV *av = (AV*)POPs; SV *sv = av_pop(av); if (AvREAL(av)) @@ -3885,7 +3961,7 @@ PP(pp_pop) PP(pp_shift) { - djSP; + dSP; AV *av = (AV*)POPs; SV *sv = av_shift(av); EXTEND(SP, 1); @@ -3899,13 +3975,13 @@ PP(pp_shift) PP(pp_unshift) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv; register I32 i = 0; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -3929,7 +4005,7 @@ PP(pp_unshift) PP(pp_reverse) { - djSP; dMARK; + dSP; dMARK; register SV *tmp; SV **oldsp = SP; @@ -3961,12 +4037,12 @@ PP(pp_reverse) U8* s = (U8*)SvPVX(TARG); U8* send = (U8*)(s + len); while (s < send) { - if (UTF8_IS_ASCII(*s)) { + if (UTF8_IS_INVARIANT(*s)) { s++; continue; } else { - if (!utf8_to_uv_simple(s, 0)) + if (!utf8_to_uvchr(s, 0)) break; up = (char*)s; s += UTF8SKIP(s); @@ -4035,9 +4111,10 @@ S_mul128(pTHX_ SV *sv, U8 m) #define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ') #endif + PP(pp_unpack) { - djSP; + dSP; dPOPPOPssrl; I32 start_sp_offset = SP - PL_stack_base; I32 gimme = GIMME_V; @@ -4045,13 +4122,20 @@ PP(pp_unpack) STRLEN llen; STRLEN rlen; register char *pat = SvPV(left, llen); +#ifdef PACKED_IS_OCTETS + /* Packed side is assumed to be octets - so force downgrade if it + has been UTF-8 encoded by accident + */ + register char *s = SvPVbyte(right, rlen); +#else register char *s = SvPV(right, rlen); +#endif char *strend = s + rlen; char *strbeg = s; register char *patend = pat + llen; I32 datumtype; register I32 len; - register I32 bits; + register I32 bits = 0; register char *str; /* These must not be in registers: */ @@ -4071,8 +4155,8 @@ PP(pp_unpack) float afloat; double adouble; I32 checksum = 0; - register U32 culong; - NV cdouble; + register U32 culong = 0; + NV cdouble = 0.0; int commas = 0; int star; #ifdef PERL_NATINT_PACK @@ -4354,7 +4438,7 @@ PP(pp_unpack) if (checksum) { while (len-- > 0 && s < strend) { STRLEN alen; - auint = utf8_to_uv((U8*)s, strend - s, &alen, 0); + auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0); along = alen; s += along; if (checksum > 32) @@ -4368,7 +4452,7 @@ PP(pp_unpack) EXTEND_MORTAL(len); while (len-- > 0 && s < strend) { STRLEN alen; - auint = utf8_to_uv((U8*)s, strend - s, &alen, 0); + auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0); along = alen; s += along; sv = NEWSV(37, 0); @@ -4780,7 +4864,8 @@ PP(pp_unpack) while ((len > 0) && (s < strend)) { auv = (auv << 7) | (*s & 0x7f); - if (UTF8_IS_ASCII(*s++)) { + /* UTF8_IS_XXXXX not right here - using constant 0x80 */ + if ((U8)(*s++) < 0x80) { bytes = 0; sv = NEWSV(40, 0); sv_setuv(sv, auv); @@ -5124,7 +5209,7 @@ S_div128(pTHX_ SV *pnum, bool *done) PP(pp_pack) { - djSP; dMARK; dORIGMARK; dTARGET; + dSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; register I32 items; STRLEN fromlen; @@ -5172,8 +5257,10 @@ PP(pp_pack) patcopy++; continue; } +#ifndef PACKED_IS_OCTETS if (datumtype == 'U' && pat == patcopy+1) SvUTF8_on(cat); +#endif if (datumtype == '#') { while (pat < patend && *pat != '\n') pat++; @@ -5396,9 +5483,26 @@ PP(pp_pack) case 'c': while (len-- > 0) { fromstr = NEXTFROM; - aint = SvIV(fromstr); - achar = aint; - sv_catpvn(cat, &achar, sizeof(char)); + switch (datumtype) { + case 'C': + aint = SvIV(fromstr); + if ((aint < 0 || aint > 255) && + ckWARN(WARN_PACK)) + Perl_warner(aTHX_ WARN_PACK, + "Character in \"C\" format wrapped"); + achar = aint & 255; + sv_catpvn(cat, &achar, sizeof(char)); + break; + case 'c': + aint = SvIV(fromstr); + if ((aint < -128 || aint > 127) && + ckWARN(WARN_PACK)) + Perl_warner(aTHX_ WARN_PACK, + "Character in \"c\" format wrapped"); + achar = aint & 255; + sv_catpvn(cat, &achar, sizeof(char)); + break; + } } break; case 'U': @@ -5406,7 +5510,7 @@ PP(pp_pack) fromstr = NEXTFROM; auint = SvUV(fromstr); SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1); - SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint) + SvCUR_set(cat, (char*)uvchr_to_utf8((U8*)SvEND(cat),auint) - SvPVX(cat)); } *SvEND(cat) = '\0'; @@ -5718,7 +5822,7 @@ PP(pp_pack) PP(pp_split) { - djSP; dTARG; + dSP; dTARG; AV *ary; register IV limit = POPi; /* note, negative is forever */ SV *sv = POPs; @@ -5777,7 +5881,7 @@ PP(pp_split) av_extend(ary,0); av_clear(ary); SPAGAIN; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)ary, mg)); } @@ -6024,7 +6128,7 @@ PP(pp_split) void Perl_unlock_condpair(pTHX_ void *svv) { - MAGIC *mg = mg_find((SV*)svv, 'm'); + MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex); if (!mg) Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex"); @@ -6041,7 +6145,7 @@ Perl_unlock_condpair(pTHX_ void *svv) PP(pp_lock) { - djSP; + dSP; dTOPss; SV *retsv = sv; #ifdef USE_THREADS @@ -6058,7 +6162,7 @@ PP(pp_lock) PP(pp_threadsv) { #ifdef USE_THREADS - djSP; + dSP; EXTEND(SP, 1); if (PL_op->op_private & OPpLVAL_INTRO) PUSHs(*save_threadsv(PL_op->op_targ));