X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=9dbee678efa584b88906f481982b73b432175f63;hb=5b3035ed4d02db655cf5d2d62ab1ebb11c131def;hp=a2990cee60fb8974c7832c3bb712a8be177996d0;hpb=cc366d4bfec1d12643c0fb8ca45074934bcc46bb;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index a2990ce..9dbee67 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;
@@ -102,7 +101,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;
@@ -140,10 +138,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 +155,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 +168,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 +179,46 @@ 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) {
+               if (hasutf)
+                 d = uv_to_utf8(d, ch);
+               else 
+                 *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;
@@ -277,7 +289,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 +317,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;
@@ -433,7 +443,6 @@ 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 &
                     (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
@@ -584,7 +593,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");
@@ -654,7 +662,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");
@@ -742,7 +749,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");
@@ -765,7 +771,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 {
     STRLEN len;
     char *s;
-    dTHR;
 
     if (SvTYPE(sv) == SVt_PVAV) {
 	register I32 i;
@@ -827,7 +832,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;
@@ -905,7 +909,6 @@ Perl_do_chomp(pTHX_ register SV *sv)
 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;