tweak perlembed for multiplicity/usethreads sanity; correct notes

[p5sagit/p5-mst-13.2.git] / doop.c

diff --git a/doop.c b/doop.c
index 0dbfe20..175d0f2 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -592,7 +592,8 @@ Perl_do_trans(pTHX_ SV *sv)
        return 0;
     if (!SvPOKp(sv))
        (void)SvPV_force(sv, len);
-    (void)SvPOK_only(sv);
+    if (!(PL_op->op_private & OPpTRANS_IDENTICAL))
+       (void)SvPOK_only_UTF8(sv);
 
     DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
 
@@ -660,12 +661,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
@@ -697,6 +695,7 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
        SvTAINTED_on(sv);
 }
 
+/* XXX SvUTF8 support missing! */
 UV
 Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 {
@@ -829,6 +828,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
     return retnum;
 }
 
+/* XXX SvUTF8 support missing! */
 void
 Perl_do_vecset(pTHX_ SV *sv)
 {
@@ -844,6 +844,7 @@ Perl_do_vecset(pTHX_ SV *sv)
     if (!targ)
        return;
     s = (unsigned char*)SvPV_force(targ, targlen);
+    (void)SvPOK_only(targ);
     lval = SvUV(sv);
     offset = LvTARGOFF(sv);
     size = LvTARGLEN(sv);
@@ -924,7 +925,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;
     }
@@ -994,7 +995,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;
     }
@@ -1060,6 +1061,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 ^= */
@@ -1084,6 +1092,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)) &&
@@ -1154,6 +1225,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
            break;
        }
     }
+finish:
     SvTAINT(sv);
 }
 
@@ -1222,7 +1294,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 */