X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=7acad602c49d32a8bc672afb9f302de58ff515ce;hb=3b0e0cb610a437b422e9557a50cdb439557976dd;hp=77c7324e3171c8638020f8c4fa49c4b01cc76b6d;hpb=33b454808819084359e76a3f223a41b842c180b7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index 77c7324..7acad60 100644
--- a/doop.c
+++ b/doop.c
@@ -36,7 +36,6 @@
 STATIC I32
 S_do_trans_simple(pTHX_ SV *sv)
 {
-    dTHR;
     U8 *s;
     U8 *d;
     U8 *send;
@@ -72,18 +71,15 @@ S_do_trans_simple(pTHX_ SV *sv)
     Newz(0, d, len*2+1, U8);
     dstart = d;
     while (s < send) {
-        I32 ulen;
+        STRLEN ulen;
         short c;
 
         ulen = 1;
         /* Need to check this, otherwise 128..255 won't match */
-	c = utf8_to_uv(s, &ulen);
+	c = utf8_to_uv(s, send - s, &ulen, 0);
         if (c < 0x100 && (ch = tbl[(short)c]) >= 0) {
             matches++;
-            if (ch < 0x80) 
-                *d++ = ch;
-            else         
-                d = uv_to_utf8(d,ch);
+            d = uv_to_utf8(d,ch);
             s += ulen;
         }
 	else { /* No match -> copy */
@@ -102,7 +98,6 @@ S_do_trans_simple(pTHX_ SV *sv)
 STATIC I32
 S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     I32 matches = 0;
@@ -122,10 +117,10 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
             s += UTF8SKIP(s);
         else {
             UV c;
-            I32 ulen;
+            STRLEN ulen;
             ulen = 1;
             if (hasutf)
-                c = utf8_to_uv(s,&ulen);
+                c = utf8_to_uv(s, send - s, &ulen, 0);
             else
                 c = *s;
             if (c < 0x100 && tbl[c] >= 0)
@@ -140,10 +135,10 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
+    U8 *dstart;
     I32 hasutf = SvUTF8(sv);
     I32 matches = 0;
     STRLEN len;
@@ -157,7 +152,9 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
     s = (U8*)SvPV(sv, len);
     send = s + len;
 
-    d = s;
+    Newz(0, d, len*2+1, U8);
+    dstart = d;
+
     if (PL_op->op_private & OPpTRANS_SQUASH) {
 	U8* p = send;
 
@@ -168,9 +165,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 	        if ((ch = tbl[*s]) >= 0) {
 		    *d = ch;
 		    matches++;
-		    if (p == d - 1 && *p == *d)
-		        matches--;
-	            else
+           if (p != d - 1 || *p != *d)
 		        p = d++;
 	        }
 	        else if (ch == -1)	/* -1 is unmapped character */
@@ -181,32 +176,43 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
     }
     else {
 	while (s < send) {
+           UV comp;
             if (hasutf && *s & 0x80)
-                s += UTF8SKIP(s);
-            else {
-	        if ((ch = tbl[*s]) >= 0) {
-		    *d = ch;
-		    matches++;
-		    d++;
-	        }
-	        else if (ch == -1)	/* -1 is unmapped character */
-		    *d++ = *s;		/* -2 is delete character */
-	        s++;
-            }
+                comp = utf8_to_uv_simple(s, NULL);
+           else
+                comp = *s;
+           
+           ch = tbl[comp];
+           
+           if (ch == -1) { /* -1 is unmapped character */
+                ch = comp;
+               matches--;
+           }
+
+           if (ch >= 0)
+               d = uv_to_utf8(d, ch);
+           
+           matches++;
+
+           s += hasutf && *s & 0x80 ? UNISKIP(*s) : 1;
+            
 	}
     }
-    matches += send - d;		/* account for disappeared chars */
+
     *d = '\0';
-    SvCUR_set(sv, d - (U8*)SvPVX(sv));
-    SvSETMAGIC(sv);
 
+    sv_setpvn(sv, (const char*)dstart, d - dstart);
+    Safefree(dstart);
+    if (hasutf)
+        SvUTF8_on(sv);
+    SvSETMAGIC(sv);
     return matches;
+
 }
 
 STATIC I32
 S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -222,7 +228,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     UV extra = none + 1;
     UV final;
     UV uv;
-    I32 isutf; 
+    I32 isutf;
     I32 howmany;
 
     isutf = SvUTF8(sv);
@@ -258,7 +264,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 	    i = UTF8SKIP(s);
 	    s += i;
 	    matches++;
-            if (i > 1 && !isutf++) 
+            if (i > 1 && !isutf++)
                 HALF_UTF8_UPGRADE(dstart,d);
 	    d = uv_to_utf8(d, final);
 	}
@@ -277,7 +283,6 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     I32 matches = 0;
@@ -306,7 +311,6 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -337,7 +341,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     if (squash) {
 	UV puv = 0xfeedface;
 	while (s < send) {
-            if (SvUTF8(sv)) 
+            if (SvUTF8(sv))
 		uv = swash_fetch(rv, s);
 	    else {
 		U8 tmpbuf[2];
@@ -354,7 +358,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    if (uv < none) {
 		matches++;
 		if (uv != puv) {
-                    if ((uv & 0x80) && !isutf++) 
+                    if ((uv & 0x80) && !isutf++)
                         HALF_UTF8_UPGRADE(dst,d);
 		    d = uv_to_utf8(d, uv);
 		    puv = uv;
@@ -363,8 +367,8 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 		continue;
 	    }
 	    else if (uv == none) {	/* "none" is unmapped character */
-		I32 ulen;
-		*d++ = (U8)utf8_to_uv(s, &ulen);
+		STRLEN ulen;
+		*d++ = (U8)utf8_to_uv(s, send - s, &ulen, 0);
 		s += ulen;
 		puv = 0xfeedface;
 		continue;
@@ -384,7 +388,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     }
     else {
 	while (s < send) {
-            if (SvUTF8(sv)) 
+            if (SvUTF8(sv))
 		uv = swash_fetch(rv, s);
 	    else {
 		U8 tmpbuf[2];
@@ -404,8 +408,8 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 		continue;
 	    }
 	    else if (uv == none) {	/* "none" is unmapped character */
-		I32 ulen;
-		*d++ = (U8)utf8_to_uv(s, &ulen);
+		STRLEN ulen;
+		*d++ = (U8)utf8_to_uv(s, send - s, &ulen, 0);
 		s += ulen;
 		continue;
 	    }
@@ -433,9 +437,8 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 I32
 Perl_do_trans(pTHX_ SV *sv)
 {
-    dTHR;
     STRLEN len;
-    I32 hasutf = (PL_op->op_private & 
+    I32 hasutf = (PL_op->op_private &
                     (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
 
     if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
@@ -547,12 +550,11 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 
     if (offset < 0)
 	return retnum;
-    if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ 
+    if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
 	Perl_croak(aTHX_ "Illegal number of bits in vec");
 
-    if (SvUTF8(sv)) {
+    if (SvUTF8(sv))
 	(void) Perl_sv_utf8_downgrade(aTHX_ sv, TRUE);
-    }
 
     offset *= size;	/* turn into bit offset */
     len = (offset + size + 7) / 8;	/* required number of bytes */
@@ -585,7 +587,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 	    }
 #ifdef UV_IS_QUAD
 	    else if (size == 64) {
-		dTHR;
 		if (ckWARN(WARN_PORTABLE))
 		    Perl_warner(aTHX_ WARN_PORTABLE,
 				"Bit vector size > 32 non-portable");
@@ -625,7 +626,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 			((UV) s[offset + 4] << 24) +
 			((UV) s[offset + 5] << 16);
 		else
-		    retnum = 
+		    retnum =
 			((UV) s[offset    ] << 56) +
 			((UV) s[offset + 1] << 48) +
 			((UV) s[offset + 2] << 40) +
@@ -655,7 +656,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 		      s[offset + 3];
 #ifdef UV_IS_QUAD
 	else if (size == 64) {
-	    dTHR;
 	    if (ckWARN(WARN_PORTABLE))
 		Perl_warner(aTHX_ WARN_PORTABLE,
 			    "Bit vector size > 32 non-portable");
@@ -708,9 +708,9 @@ Perl_do_vecset(pTHX_ SV *sv)
     if (offset < 0)
 	Perl_croak(aTHX_ "Assigning to negative offset in vec");
     size = LvTARGLEN(sv);
-    if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ 
+    if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
 	Perl_croak(aTHX_ "Illegal number of bits in vec");
-    
+
     offset *= size;			/* turn into bit offset */
     len = (offset + size + 7) / 8;	/* required number of bytes */
     if (len > targlen) {
@@ -718,7 +718,7 @@ Perl_do_vecset(pTHX_ SV *sv)
 	(void)memzero((char *)(s + targlen), len - targlen + 1);
 	SvCUR_set(targ, len);
     }
-    
+
     if (size < 8) {
 	mask = (1 << size) - 1;
 	size = offset & 7;
@@ -743,7 +743,6 @@ Perl_do_vecset(pTHX_ SV *sv)
 	}
 #ifdef UV_IS_QUAD
 	else if (size == 64) {
-	    dTHR;
 	    if (ckWARN(WARN_PORTABLE))
 		Perl_warner(aTHX_ WARN_PORTABLE,
 			    "Bit vector size > 32 non-portable");
@@ -766,8 +765,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 {
     STRLEN len;
     char *s;
-    dTHR;
-    
+
     if (SvTYPE(sv) == SVt_PVAV) {
 	register I32 i;
         I32 max;
@@ -828,7 +826,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 I32
 Perl_do_chomp(pTHX_ register SV *sv)
 {
-    dTHR;
     register I32 count;
     STRLEN len;
     char *s;
@@ -901,12 +898,11 @@ Perl_do_chomp(pTHX_ register SV *sv)
   nope:
     SvSETMAGIC(sv);
     return count;
-} 
+}
 
 void
 Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 {
-    dTHR;	/* just for taint */
 #ifdef LIBERAL
     register long *dl;
     register long *ll;
@@ -927,7 +923,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 
     if (left_utf && !right_utf)
 	sv_utf8_upgrade(right);
-    if (!left_utf && right_utf)
+    else if (!left_utf && right_utf)
 	sv_utf8_upgrade(left);
 
     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
@@ -964,15 +960,15 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 	char *dcsave = dc;
 	STRLEN lulen = leftlen;
 	STRLEN rulen = rightlen;
-	I32 ulen;
+	STRLEN ulen;
 
 	switch (optype) {
 	case OP_BIT_AND:
 	    while (lulen && rulen) {
-		luc = utf8_to_uv((U8*)lc, &ulen);
+		luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
 		lc += ulen;
 		lulen -= ulen;
-		ruc = utf8_to_uv((U8*)rc, &ulen);
+		ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
 		rc += ulen;
 		rulen -= ulen;
 		duc = luc & ruc;
@@ -984,10 +980,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 	    break;
 	case OP_BIT_XOR:
 	    while (lulen && rulen) {
-		luc = utf8_to_uv((U8*)lc, &ulen);
+		luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
 		lc += ulen;
 		lulen -= ulen;
-		ruc = utf8_to_uv((U8*)rc, &ulen);
+		ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
 		rc += ulen;
 		rulen -= ulen;
 		duc = luc ^ ruc;
@@ -996,10 +992,10 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 	    goto mop_up_utf;
 	case OP_BIT_OR:
 	    while (lulen && rulen) {
-		luc = utf8_to_uv((U8*)lc, &ulen);
+		luc = utf8_to_uv((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
 		lc += ulen;
 		lulen -= ulen;
-		ruc = utf8_to_uv((U8*)rc, &ulen);
+		ruc = utf8_to_uv((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
 		rc += ulen;
 		rulen -= ulen;
 		duc = luc | ruc;
@@ -1107,8 +1103,8 @@ Perl_do_kv(pTHX)
     I32 dokeys =   (PL_op->op_type == OP_KEYS);
     I32 dovalues = (PL_op->op_type == OP_VALUES);
     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
-    
-    if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
+
+    if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
 	dokeys = dovalues = TRUE;
 
     if (!hv) {