X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=06b1b38d5c85f4e43518ecc9376448aab054bb26;hb=57a264f964d3bc3cfc103b72615b68710b3a4b9a;hp=a0fa7297923c1fb46ab854dd90a3315fd2d93611;hpb=cb50131aab68ac6dda048612c6e853b8cb08701e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index a0fa729..06b1b38 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);
@@ -924,7 +924,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 +956,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 +994,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 +1060,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 +1091,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 +1224,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 	    break;
 	}
     }
+finish:
     SvTAINT(sv);
 }
 
@@ -1221,7 +1293,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 */