X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=1495953955cdda5a6caf94cbf3c615548d06ae55;hb=bbbf5d77f86bf2c0500b791adc75e990b503ac14;hp=f6dbe67a6bf46f491a47e5095233eeb677cc1586;hpb=a0dbb04553005cdbafdeb7435a79ae500b5aa8ff;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index f6dbe67..1495953 100644
--- a/doop.c
+++ b/doop.c
@@ -29,6 +29,7 @@ S_do_trans_simple(pTHX_ SV *sv)
     U8 *send;
     U8 *dstart;
     I32 matches = 0;
+    I32 grows = PL_op->op_private & OPpTRANS_GROWS;
     STRLEN len;
     short *tbl;
     I32 ch;
@@ -55,30 +56,36 @@ S_do_trans_simple(pTHX_ SV *sv)
     }
 
     /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
-    Newz(0, d, len*2+1, U8);
+    if (grows)
+	New(0, d, len*2+1, U8);
+    else
+	d = s;
     dstart = d;
     while (s < send) {
         STRLEN ulen;
-        short c;
+        UV c;
 
-        ulen = 1;
         /* Need to check this, otherwise 128..255 won't match */
 	c = utf8_to_uv(s, send - s, &ulen, 0);
-        if (c < 0x100 && (ch = tbl[(short)c]) >= 0) {
+        if (c < 0x100 && (ch = tbl[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 */
-            while (ulen--)
-                *d++ = *s++;
+	    Copy(s, d, ulen, U8);
+	    d += ulen;
+	    s += ulen;
         }
     }
-    *d = '\0';
-    sv_setpvn(sv, (char*)dstart, d - dstart);
+    if (grows) {
+	sv_setpvn(sv, (char*)dstart, d - dstart);
+	Safefree(dstart);
+    }
+    else {
+	*d = '\0';
+	SvCUR_set(sv, d - dstart);
+    }
     SvUTF8_on(sv);
     SvSETMAGIC(sv);
     return matches;
@@ -127,6 +134,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
     U8 *dstart;
     I32 isutf8;
     I32 matches = 0;
+    I32 grows = PL_op->op_private & OPpTRANS_GROWS;
     STRLEN len;
     short *tbl;
     I32 ch;
@@ -173,7 +181,10 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 	SvCUR_set(sv, d - dstart);
     }
     else { /* isutf8 */
-	Newz(0, d, len*2+1, U8);
+	if (grows)
+	    New(0, d, len*2+1, U8);
+	else
+	    d = s;
 	dstart = d;
 
 	if (PL_op->op_private & OPpTRANS_SQUASH) {
@@ -183,8 +194,10 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 		STRLEN len;
 	        UV comp = utf8_to_uv_simple(s, &len);
 
-		if (comp > 0xff)
-		    d = uv_to_utf8(d, comp);	/* always unmapped */
+		if (comp > 0xff) {	/* always unmapped */	
+		    Copy(s, d, len, U8);
+		    d += len;
+		}
 		else if ((ch = tbl[comp]) >= 0) {
 		    matches++;
 		    if (ch != pch) {
@@ -194,8 +207,10 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 		    s += len;
 		    continue;
 		}
-		else if (ch == -1)	/* -1 is unmapped character */
-		    d = uv_to_utf8(d, comp);
+		else if (ch == -1) {	/* -1 is unmapped character */
+		    Copy(s, d, len, U8);
+		    d += len;
+		}
 		else if (ch == -2)      /* -2 is delete character */
 		    matches++;
 		s += len;
@@ -206,22 +221,31 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 	    while (s < send) {
 		STRLEN len;
 	        UV comp = utf8_to_uv_simple(s, &len);
-		if (comp > 0xff)
-		    d = uv_to_utf8(d, comp);	/* always unmapped */
+		if (comp > 0xff) {	/* always unmapped */
+		    Copy(s, d, len, U8);
+		    d += len;
+		}
 		else if ((ch = tbl[comp]) >= 0) {
 		    d = uv_to_utf8(d, ch);
 		    matches++;
 		}
 		else if (ch == -1) {	/* -1 is unmapped character */
-		    d = uv_to_utf8(d, comp);
+		    Copy(s, d, len, U8);
+		    d += len;
 		}
 		else if (ch == -2)      /* -2 is delete character */
 		    matches++;
 		s += len;
 	    }
 	}
-	*d = '\0';
-	sv_setpvn(sv, (char*)dstart, d - dstart);
+	if (grows) {
+	    sv_setpvn(sv, (char*)dstart, d - dstart);
+	    Safefree(dstart);
+	}
+	else {
+	    *d = '\0';
+	    SvCUR_set(sv, d - dstart);
+	}
 	SvUTF8_on(sv);
     }
     SvSETMAGIC(sv);
@@ -237,6 +261,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     U8 *start;
     U8 *dstart, *dend;
     I32 matches = 0;
+    I32 grows = PL_op->op_private & OPpTRANS_GROWS;
     STRLEN len;
 
     SV* rv = (SV*)cSVOP->op_sv;
@@ -254,7 +279,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     if (!isutf8) {
 	U8 *t = s, *e = s + len;
 	while (t < e)
-	    if ((hibit = *t++ & 0x80))
+	    if ((hibit = UTF8_IS_CONTINUED(*t++)))
 		break;
 	if (hibit)
 	    s = bytes_to_utf8(s, &len);
@@ -266,10 +291,16 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     if (svp)
 	final = SvUV(*svp);
 
-    /* d needs to be bigger than s, in case e.g. upgrading is required */
-    New(0, d, len*3+UTF8_MAXLEN, U8);
-    dend = d + len * 3;
-    dstart = d;
+    if (grows) {
+	/* d needs to be bigger than s, in case e.g. upgrading is required */
+	New(0, d, len*3+UTF8_MAXLEN, U8);
+	dend = d + len * 3;
+	dstart = d;
+    }
+    else {
+	dstart = d = s;
+	dend = d + len;
+    }
 
     while (s < send) {
 	if ((uv = swash_fetch(rv, s)) < none) {
@@ -279,8 +310,9 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 	}
 	else if (uv == none) {
 	    int i = UTF8SKIP(s);
-	    while(i--)
-		*d++ = *s++;
+	    Copy(s, d, i, U8);
+	    d += i;
+	    s += i;
 	}
 	else if (uv == extra) {
 	    int i = UTF8SKIP(s);
@@ -291,20 +323,28 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 	else
 	    s += UTF8SKIP(s);
 
-	if (d >= dend) {
+	if (d > dend) {
 	    STRLEN clen = d - dstart;
 	    STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
+	    if (!grows)
+		Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
 	    Renew(dstart, nlen+UTF8_MAXLEN, U8);
 	    d = dstart + clen;
 	    dend = dstart + nlen;
 	}
     }
-    *d = '\0';
-    sv_setpvn(sv, (char*)dstart, d - dstart);
+    if (grows || hibit) {
+	sv_setpvn(sv, (char*)dstart, d - dstart);
+	Safefree(dstart);
+	if (grows && hibit)
+	    Safefree(start);
+    }
+    else {
+	*d = '\0';
+	SvCUR_set(sv, d - dstart);
+    }
     SvSETMAGIC(sv);
     SvUTF8_on(sv);
-    if (hibit)
-	Safefree(start);
     if (!isutf8 && !(PL_hints & HINT_UTF8))
 	sv_utf8_downgrade(sv, TRUE);
 
@@ -330,7 +370,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
     if (!SvUTF8(sv)) {
 	U8 *t = s, *e = s + len;
 	while (t < e)
-	    if ((hibit = *t++ & 0x80))
+	    if ((hibit = !UTF8_IS_ASCII(*t++)))
 		break;
 	if (hibit)
 	    start = s = bytes_to_utf8(s, &len);
@@ -357,6 +397,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     I32 matches = 0;
     I32 squash   = PL_op->op_private & OPpTRANS_SQUASH;
     I32 del      = PL_op->op_private & OPpTRANS_DELETE;
+    I32 grows    = PL_op->op_private & OPpTRANS_GROWS;
     SV* rv = (SV*)cSVOP->op_sv;
     HV* hv = (HV*)SvRV(rv);
     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
@@ -374,7 +415,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     if (!isutf8) {
 	U8 *t = s, *e = s + len;
 	while (t < e)
-	    if ((hibit = *t++ & 0x80))
+	    if ((hibit = !UTF8_IS_ASCII(*t++)))
 		break;
 	if (hibit)
 	    s = bytes_to_utf8(s, &len);
@@ -386,17 +427,27 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     if (svp)
 	final = SvUV(*svp);
 
-    New(0, d, len*3+UTF8_MAXLEN, U8);
-    dend = d + len * 3;
-    dstart = d;
+    if (grows) {
+	/* d needs to be bigger than s, in case e.g. upgrading is required */
+	New(0, d, len*3+UTF8_MAXLEN, U8);
+	dend = d + len * 3;
+	dstart = d;
+    }
+    else {
+	dstart = d = s;
+	dend = d + len;
+    }
 
     if (squash) {
 	UV puv = 0xfeedface;
 	while (s < send) {
 	    uv = swash_fetch(rv, s);
 	    
-	    if (d >= dend) {
-	        STRLEN clen = d - dstart, nlen = dend - dstart + len;
+	    if (d > dend) {
+	        STRLEN clen = d - dstart;
+		STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
+		if (!grows)
+		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
 		Renew(dstart, nlen+UTF8_MAXLEN, U8);
 		d = dstart + clen;
 		dend = dstart + nlen;
@@ -412,8 +463,9 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    }
 	    else if (uv == none) {	/* "none" is unmapped character */
 		int i = UTF8SKIP(s);
-		while(i--)
-		    *d++ = *s++;
+		Copy(s, d, i, U8);
+		d += i;
+		s += i;
 		puv = 0xfeedface;
 		continue;
 	    }
@@ -433,8 +485,11 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     else {
 	while (s < send) {
 	    uv = swash_fetch(rv, s);
-	    if (d >= dend) {
-	        STRLEN clen = d - dstart, nlen = dend - dstart + len;
+	    if (d > dend) {
+	        STRLEN clen = d - dstart;
+		STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
+		if (!grows)
+		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
 		Renew(dstart, nlen+UTF8_MAXLEN, U8);
 		d = dstart + clen;
 		dend = dstart + nlen;
@@ -447,8 +502,9 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    }
 	    else if (uv == none) {	/* "none" is unmapped character */
 		int i = UTF8SKIP(s);
-		while(i--)
-		    *d++ = *s++;
+		Copy(s, d, i, U8);
+		d += i;
+		s += i;
 		continue;
 	    }
 	    else if (uv == extra && !del) {
@@ -461,11 +517,17 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    s += UTF8SKIP(s);
 	}
     }
-    *d = '\0';
-    sv_setpvn(sv, (char*)dstart, d - dstart);
+    if (grows || hibit) {
+	sv_setpvn(sv, (char*)dstart, d - dstart);
+	Safefree(dstart);
+	if (grows && hibit)
+	    Safefree(start);
+    }
+    else {
+	*d = '\0';
+	SvCUR_set(sv, d - dstart);
+    }
     SvUTF8_on(sv);
-    if (hibit)
-	Safefree(start);
     if (!isutf8 && !(PL_hints & HINT_UTF8))
 	sv_utf8_downgrade(sv, TRUE);
     SvSETMAGIC(sv);
@@ -1144,7 +1206,7 @@ Perl_do_kv(pTHX)
 	dokeys = dovalues = TRUE;
 
     if (!hv) {
-	if (PL_op->op_flags & OPf_MOD) {	/* lvalue */
+	if (PL_op->op_flags & OPf_MOD || LVRET) {	/* lvalue */
 	    dTARGET;		/* make sure to clear its target here */
 	    if (SvTYPE(TARG) == SVt_PVLV)
 		LvTARG(TARG) = Nullsv;
@@ -1163,7 +1225,7 @@ Perl_do_kv(pTHX)
 	IV i;
 	dTARGET;
 
-	if (PL_op->op_flags & OPf_MOD) {	/* lvalue */
+	if (PL_op->op_flags & OPf_MOD || LVRET) {	/* lvalue */
 	    if (SvTYPE(TARG) < SVt_PVLV) {
 		sv_upgrade(TARG, SVt_PVLV);
 		sv_magic(TARG, Nullsv, 'k', Nullch, 0);