concat doesn't preserve utf8-ness, and doesn't invalidate

[NI]OK; added tests for both

p4raw-id: //depot/perl@6090

diff --git a/perl.c b/perl.c
index df09399..6244753 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3220,7 +3220,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            SV *sv = newSVpv(argv[0],0);
            av_push(GvAVn(PL_argvgv),sv);
            if (PL_widesyscalls)
-               sv_utf8_upgrade(sv);
+               (void)sv_utf8_decode(sv);
        }
     }
     if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {

diff --git a/pp_hot.c b/pp_hot.c
index 5db5eab..2a8aa9b 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -146,22 +146,36 @@ PP(pp_concat)
     dPOPTOPssrl;
     STRLEN len;
     char *s;
+    bool left_utf = DO_UTF8(left);
+    bool right_utf = DO_UTF8(right);
 
     if (TARG != left) {
+       if (right_utf && !left_utf)
+           sv_utf8_upgrade(left);
        s = SvPV(left,len);
+       SvUTF8_off(TARG);
        if (TARG == right) {
+           if (left_utf && !right_utf)
+               sv_utf8_upgrade(right);
            sv_insert(TARG, 0, 0, s, len);
+           if (left_utf || right_utf)
+               SvUTF8_on(TARG);
            SETs(TARG);
            RETURN;
        }
        sv_setpvn(TARG,s,len);
     }
-    else if (SvGMAGICAL(TARG))
+    else if (SvGMAGICAL(TARG)) {
        mg_get(TARG);
+       if (right_utf && !left_utf)
+           sv_utf8_upgrade(left);
+    }
     else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
        sv_setpv(TARG, "");     /* Suppress warning. */
        s = SvPV_force(TARG, len);
     }
+    if (left_utf && !right_utf)
+       sv_utf8_upgrade(right);
     s = SvPV(right,len);
     if (SvOK(TARG)) {
 #if defined(PERL_Y2KWARN)
@@ -176,19 +190,12 @@ PP(pp_concat)
            }
        }
 #endif
-       if (DO_UTF8(right))
-           sv_utf8_upgrade(TARG);
        sv_catpvn(TARG,s,len);
-       if (!IN_BYTE) {
-           if (SvUTF8(right))
-               SvUTF8_on(TARG);
-       }
-       else if (!SvUTF8(right)) {
-           SvUTF8_off(TARG);
-       }
     }
     else
        sv_setpvn(TARG,s,len);  /* suppress warning */
+    if (left_utf || right_utf)
+       SvUTF8_on(TARG);
     SETTARG;
     RETURN;
   }

diff --git a/sv.c b/sv.c
index a5cb9e6..fb68efa 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3104,11 +3104,13 @@ Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
     if (!sstr)
        return;
     if ((s = SvPV(sstr, len))) {
-       if (SvUTF8(sstr))
+       if (DO_UTF8(sstr)) {
            sv_utf8_upgrade(dstr);
-       sv_catpvn(dstr,s,len);
-       if (SvUTF8(sstr))
+           sv_catpvn(dstr,s,len);
            SvUTF8_on(dstr);
+       }
+       else
+           sv_catpvn(dstr,s,len);
     }
 }
 
@@ -3465,6 +3467,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN
     if (!bigstr)
        Perl_croak(aTHX_ "Can't modify non-existent substring");
     SvPV_force(bigstr, curlen);
+    SvPOK_only_UTF8(bigstr);
     if (offset + len > curlen) {
        SvGROW(bigstr, offset+len+1);
        Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);

diff --git a/t/op/substr.t b/t/op/substr.t
index d3668ac..f2a0c6c 100755 (executable)
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..132\n";
+print "1..135\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
@@ -271,18 +271,29 @@ $a = "abcdefgh";
 ok 124, sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
 ok 125, $a eq 'xxxxefgh';
 
+{
+    my $y = 10;
+    $y = "2" . $y;
+    ok 126, $y+0 == 210;
+}
+
 # utf8 sanity
 {
     my $x = substr("a\x{263a}b",0);
-    ok 126, length($x) == 3;
+    ok 127, length($x) == 3;
     $x = substr($x,1,1);
-    ok 127, $x eq "\x{263a}";
+    ok 128, $x eq "\x{263a}";
     $x = $x x 2;
-    ok 128, length($x) == 2;
+    ok 129, length($x) == 2;
     substr($x,0,1) = "abcd";
-    ok 129, $x eq "abcd\x{263a}";
-    ok 130, length($x) == 5;
-    $x = reverse $x;
+    ok 130, $x eq "abcd\x{263a}";
     ok 131, length($x) == 5;
-    ok 132, $x eq "\x{263a}dcba";
+    $x = reverse $x;
+    ok 132, length($x) == 5;
+    ok 133, $x eq "\x{263a}dcba";
+
+    my $z = 10;
+    $z = "21\x{263a}" . $z;
+    ok 134, length($z) == 5;
+    ok 135, $z eq "21\x{263a}10";
 }