Integrate changes #9259,9260 from maintperl into mainline.

[perl5.git] / doop.c

diff --git a/doop.c b/doop.c
index 1a1ba8f..823c88d 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -213,7 +213,8 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
                    else {
                        matches++;
                        if (!del) {
-                           ch = (comp - 0x100 < rlen) ?
+                           ch = (rlen == 0) ? comp :
+                               (comp - 0x100 < rlen) ?
                                tbl[comp+1] : tbl[0x100+rlen];
                            if (ch != pch) {
                                d = uvchr_to_utf8(d, ch);
@@ -315,9 +316,11 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
     isutf8 = SvUTF8(sv);
     if (!isutf8) {
        U8 *t = s, *e = s + len;
-       while (t < e)
-           if ((hibit = UTF8_IS_CONTINUED(*t++)))
+       while (t < e) {
+           U8 ch = *t++;
+           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
                break;
+       }
        if (hibit)
            s = bytes_to_utf8(s, &len);
     }
@@ -401,22 +404,25 @@ 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;
 
     s = (U8*)SvPV(sv, len);
     if (!SvUTF8(sv)) {
        U8 *t = s, *e = s + len;
-       while (t < e)
-           if ((hibit = !UTF8_IS_ASCII(*t++)))
+       while (t < e) {
+           U8 ch = *t++;
+           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
                break;
+       }
        if (hibit)
            start = s = bytes_to_utf8(s, &len);
     }
     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);
     }
@@ -442,6 +448,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;
@@ -452,9 +459,11 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
     isutf8 = SvUTF8(sv);
     if (!isutf8) {
        U8 *t = s, *e = s + len;
-       while (t < e)
-           if ((hibit = !UTF8_IS_ASCII(*t++)))
+       while (t < e) {
+           U8 ch = *t++;
+           if ((hibit = !NATIVE_IS_INVARIANT(ch)))
                break;
+       }
        if (hibit)
            s = bytes_to_utf8(s, &len);
     }
@@ -462,8 +471,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 */
@@ -509,10 +520,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 = uvchr_to_utf8(d, final);
+                       puv = final;
+                   }
+               }
+               else {
+                   STRLEN len;
+                   uv = utf8_to_uvchr(s, &len);
+                   if (uv != puv) {
+                       Copy(s, d, len, U8);
+                       d += len;
+                       puv = uv;
+                   }
+                   s += len;
                }
                continue;
            }
@@ -601,6 +624,7 @@ Perl_do_trans(pTHX_ SV *sv)
            return do_trans_simple(sv);
 
     case OPpTRANS_IDENTICAL:
+    case OPpTRANS_IDENTICAL|OPpTRANS_COMPLEMENT:
        if (hasutf)
            return do_trans_count_utf8(sv);
        else