X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=d7baecc792213d049dbf1319ba037bebbfa6c3f1;hb=b64ef0c16412e85153146d233da1aa73ec918e8f;hp=f2bda8b08d04598ddd835442c5d227b14d4543a2;hpb=c4d5f83add3e03ac76c328ed8a29701d939174ce;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index f2bda8b..d7baecc 100644
--- a/doop.c
+++ b/doop.c
@@ -36,7 +36,7 @@ S_do_trans_simple(pTHX_ SV *sv)
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-	Perl_croak(aTHX_ "panic: do_trans_simple");
+	Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -103,7 +103,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-	Perl_croak(aTHX_ "panic: do_trans_count");
+	Perl_croak(aTHX_ "panic: do_trans_count line %d",__LINE__);
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -147,7 +147,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-	Perl_croak(aTHX_ "panic: do_trans_complex");
+	Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__);
 
     s = (U8*)SvPV(sv, len);
     isutf8 = SvUTF8(sv);
@@ -184,6 +184,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 		s++;
 	    }
 	}
+	*d = '\0';
 	SvCUR_set(sv, d - dstart);
     }
     else { /* isutf8 */
@@ -346,7 +347,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 	if ((uv = swash_fetch(rv, s)) < none) {
 	    s += UTF8SKIP(s);
 	    matches++;
-	    d = uvchr_to_utf8(d, uv);
+	    d = uvuni_to_utf8(d, uv);
 	}
 	else if (uv == none) {
 	    int i = UTF8SKIP(s);
@@ -358,7 +359,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 	    int i = UTF8SKIP(s);
 	    s += i;
 	    matches++;
-	    d = uvchr_to_utf8(d, final);
+	    d = uvuni_to_utf8(d, final);
 	}
 	else
 	    s += UTF8SKIP(s);
@@ -367,7 +368,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 	    STRLEN clen = d - dstart;
 	    STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
 	    if (!grows)
-		Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
+		Perl_croak(aTHX_ "panic: do_trans_simple_utf8 line %d",__LINE__);
 	    Renew(dstart, nlen+UTF8_MAXLEN, U8);
 	    d = dstart + clen;
 	    dend = dstart + nlen;
@@ -404,6 +405,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
     HV* hv = (HV*)SvRV(rv);
     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
     UV none = svp ? SvUV(*svp) : 0x7fffffff;
+    UV extra = none + 1;
     UV uv;
     U8 hibit = 0;
 
@@ -421,7 +423,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
     send = s + len;
 
     while (s < send) {
-	if ((uv = swash_fetch(rv, s)) < none)
+	if ((uv = swash_fetch(rv, s)) < none || uv == extra)
 	    matches++;
 	s += UTF8SKIP(s);
     }
@@ -447,6 +449,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     UV none = svp ? SvUV(*svp) : 0x7fffffff;
     UV extra = none + 1;
     UV final;
+    bool havefinal = FALSE;
     UV uv;
     STRLEN len;
     U8 *dstart, *dend;
@@ -469,8 +472,10 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     start = s;
 
     svp = hv_fetch(hv, "FINAL", 5, FALSE);
-    if (svp)
+    if (svp) {
 	final = SvUV(*svp);
+	havefinal = TRUE;
+    }
 
     if (grows) {
 	/* d needs to be bigger than s, in case e.g. upgrading is required */
@@ -492,7 +497,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	        STRLEN clen = d - dstart;
 		STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
 		if (!grows)
-		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
+		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
 		Renew(dstart, nlen+UTF8_MAXLEN, U8);
 		d = dstart + clen;
 		dend = dstart + nlen;
@@ -501,7 +506,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 		matches++;
 		s += UTF8SKIP(s);
 		if (uv != puv) {
-		    d = uvchr_to_utf8(d, uv);
+		    d = uvuni_to_utf8(d, uv);
 		    puv = uv;
 		}
 		continue;
@@ -516,10 +521,22 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    }
 	    else if (uv == extra && !del) {
 		matches++;
-		s += UTF8SKIP(s);
-		if (uv != puv) {
-		    d = uvchr_to_utf8(d, final);
-		    puv = final;
+		if (havefinal) {
+		    s += UTF8SKIP(s);
+		    if (puv != final) {
+			d = uvuni_to_utf8(d, final);
+			puv = final;
+		    }
+		}
+		else {
+		    STRLEN len;
+		    uv = utf8_to_uvuni(s, &len);
+		    if (uv != puv) {
+			Copy(s, d, len, U8);
+			d += len;
+			puv = uv;
+		    }
+		    s += len;
 		}
 		continue;
 	    }
@@ -534,7 +551,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	        STRLEN clen = d - dstart;
 		STRLEN nlen = dend - dstart + len + UTF8_MAXLEN;
 		if (!grows)
-		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8");
+		    Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
 		Renew(dstart, nlen+UTF8_MAXLEN, U8);
 		d = dstart + clen;
 		dend = dstart + nlen;
@@ -542,7 +559,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    if (uv < none) {
 		matches++;
 		s += UTF8SKIP(s);
-		d = uvchr_to_utf8(d, uv);
+		d = uvuni_to_utf8(d, uv);
 		continue;
 	    }
 	    else if (uv == none) {	/* "none" is unmapped character */
@@ -555,7 +572,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 	    else if (uv == extra && !del) {
 		matches++;
 		s += UTF8SKIP(s);
-		d = uvchr_to_utf8(d, final);
+		d = uvuni_to_utf8(d, final);
 		continue;
 	    }
 	    matches++;			/* "none+1" is delete character */