X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=4224b0ea13bd95e37654d2c23db2a2cd641dad30;hb=be341bcebb03d2f97192fb78a6a1bc33c7bca5ce;hp=a0fa7297923c1fb46ab854dd90a3315fd2d93611;hpb=1761cee512762c09b2a848d3c6cbd5a3b4232ffa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index a0fa729..4224b0e 100644 --- a/doop.c +++ b/doop.c @@ -282,7 +282,7 @@ S_do_trans_CU_simple(pTHX_ SV *sv) UV extra = none + 1; UV final; UV uv; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; I32 bits = 16; s = (U8*)SvPV(sv, len); @@ -660,12 +660,9 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s if (items-- > 0) { char *s; - if (*mark) { - s = SvPV(*mark, tmplen); - sv_setpvn(sv, s, tmplen); - } - else - sv_setpv(sv, ""); + sv_setpv(sv, ""); + if (*mark) + sv_catsv(sv, *mark); mark++; } else @@ -924,7 +921,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) HE* entry; (void)hv_iterinit(hv); /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) + while ((entry = hv_iternext(hv))) do_chop(astr,hv_iterval(hv,entry)); return; } @@ -956,6 +953,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) sv_setpvn(astr, s, 1); *s = '\0'; SvCUR_set(sv, len); + SvUTF8_off(sv); SvNIOK_off(sv); } else @@ -993,7 +991,7 @@ Perl_do_chomp(pTHX_ register SV *sv) HE* entry; (void)hv_iterinit(hv); /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) + while ((entry = hv_iternext(hv))) count += do_chomp(hv_iterval(hv,entry)); return count; } @@ -1059,6 +1057,13 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) I32 lensave; char *lsave; char *rsave; + bool left_utf = DO_UTF8(left); + bool right_utf = DO_UTF8(right); + + if (left_utf && !right_utf) + sv_utf8_upgrade(right); + if (!left_utf && right_utf) + sv_utf8_upgrade(left); if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */ @@ -1083,6 +1088,69 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) } SvCUR_set(sv, len); (void)SvPOK_only(sv); + if (left_utf || right_utf) { + UV duc, luc, ruc; + STRLEN lulen = leftlen; + STRLEN rulen = rightlen; + STRLEN dulen = 0; + I32 ulen; + + if (optype != OP_BIT_AND) + dc = SvGROW(sv, leftlen+rightlen+1); + + switch (optype) { + case OP_BIT_AND: + while (lulen && rulen) { + luc = utf8_to_uv((U8*)lc, &ulen); + lc += ulen; + lulen -= ulen; + ruc = utf8_to_uv((U8*)rc, &ulen); + rc += ulen; + rulen -= ulen; + duc = luc & ruc; + dc = (char*)uv_to_utf8((U8*)dc, duc); + } + dulen = dc - SvPVX(sv); + SvCUR_set(sv, dulen); + break; + case OP_BIT_XOR: + while (lulen && rulen) { + luc = utf8_to_uv((U8*)lc, &ulen); + lc += ulen; + lulen -= ulen; + ruc = utf8_to_uv((U8*)rc, &ulen); + rc += ulen; + rulen -= ulen; + duc = luc ^ ruc; + dc = (char*)uv_to_utf8((U8*)dc, duc); + } + goto mop_up_utf; + case OP_BIT_OR: + while (lulen && rulen) { + luc = utf8_to_uv((U8*)lc, &ulen); + lc += ulen; + lulen -= ulen; + ruc = utf8_to_uv((U8*)rc, &ulen); + rc += ulen; + rulen -= ulen; + duc = luc | ruc; + dc = (char*)uv_to_utf8((U8*)dc, duc); + } + mop_up_utf: + dulen = dc - SvPVX(sv); + SvCUR_set(sv, dulen); + if (rulen) + sv_catpvn(sv, rc, rulen); + else if (lulen) + sv_catpvn(sv, lc, lulen); + else + *SvEND(sv) = '\0'; + break; + } + SvUTF8_on(sv); + goto finish; + } + else #ifdef LIBERAL if (len >= sizeof(long)*4 && !((long)dc % sizeof(long)) && @@ -1153,6 +1221,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) break; } } +finish: SvTAINT(sv); } @@ -1221,7 +1290,7 @@ Perl_do_kv(pTHX) EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues)); PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ - while (entry = hv_iternext(keys)) { + while ((entry = hv_iternext(keys))) { SPAGAIN; if (dokeys) XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */