Integrate with Sarathy.

p4raw-id: //depot/cfgperl@6091

8 files changed, 60 insertions, 35 deletions

diff --git a/perl.c b/perl.c
index df09399a49..6244753eb3 100644
--- 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/pod/buildtoc b/pod/buildtoc
index 21fee31b38..58bfc54fd7 100644
--- a/pod/buildtoc
+++ b/pod/buildtoc
@@ -177,10 +177,11 @@ sub podset {
 	    $inhead2 = 1;
 	    output $_; nl(); next;
 	}
-	if (s/^=item ([^=].*)\n/$1/) {
+	if (s/^=item ([^=].*)/$1/) {
 	    next if $pod eq 'perldiag';
 	    s/^\s*\*\s*$// && next;
 	    s/^\s*\*\s*//;
+	    s/\n/ /g;
 	    s/\s+$//;
 	    next if /^[\d.]+$/;
 	    next if $pod eq 'perlmodlib' && /^ftp:/;
diff --git a/pp.c b/pp.c
index 03ced37ca9..e148197c97 100644
--- a/pp.c
+++ b/pp.c
@@ -1078,7 +1078,7 @@ PP(pp_repeat)
     else {	/* Note: mark already snarfed by pp_list */
 	SV *tmpstr = POPs;
 	STRLEN len;
-	bool isutf = SvUTF8(tmpstr) ? TRUE : FALSE;
+	bool isutf = DO_UTF8(tmpstr);
 
 	SvSetSV(TARG, tmpstr);
 	SvPV_force(TARG, len);
@@ -2212,7 +2212,6 @@ PP(pp_chr)
     tmps = SvPVX(TARG);
     *tmps++ = value;
     *tmps = '\0';
-    SvUTF8_off(TARG);				/* decontaminate */
     (void)SvPOK_only(TARG);
     XPUSHs(TARG);
     RETURN;
@@ -2545,7 +2544,7 @@ PP(pp_quotemeta)
 	}
 	*d = '\0';
 	SvCUR_set(TARG, d - SvPVX(TARG));
-	(void)SvPOK_only(TARG);
+	(void)SvPOK_only_UTF8(TARG);
     }
     else
 	sv_setpvn(TARG, s, len);
@@ -3234,7 +3233,7 @@ PP(pp_reverse)
 		*up++ = *down;
 		*down-- = tmp;
 	    }
-	    (void)SvPOK_only(TARG);
+	    (void)SvPOK_only_UTF8(TARG);
 	}
 	SP = MARK + 1;
 	SETTARG;
diff --git a/pp_hot.c b/pp_hot.c
index 5db5eab6f7..2a8aa9b0c5 100644
--- 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 add445bfef..fb68efae2f 100644
--- a/sv.c
+++ b/sv.c
@@ -2774,10 +2774,6 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    SvPV_set(dstr, SvPVX(sstr));
 	    SvLEN_set(dstr, SvLEN(sstr));
 	    SvCUR_set(dstr, SvCUR(sstr));
-	    if (SvUTF8(sstr))
-		SvUTF8_on(dstr);
-	    else
-		SvUTF8_off(dstr);
 
 	    SvTEMP_off(dstr);
 	    (void)SvOK_off(sstr);		/* NOTE: nukes most SvFLAGS on sstr */
@@ -2795,7 +2791,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    *SvEND(dstr) = '\0';
 	    (void)SvPOK_only(dstr);
 	}
-	if (DO_UTF8(sstr))
+	if ((sflags & SVf_UTF8) && !IN_BYTE)
 	    SvUTF8_on(dstr);
 	/*SUPPRESS 560*/
 	if (sflags & SVp_NOK) {
@@ -3108,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);
     }
 }
 
@@ -3469,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/quotemeta.t b/t/op/quotemeta.t
index 60e5b7be05..ec247f8ce7 100755
--- a/t/op/quotemeta.t
+++ b/t/op/quotemeta.t
@@ -6,14 +6,14 @@ BEGIN {
     require Config; import Config;
 }
 
-print "1..15\n";
+print "1..17\n";
 
 if ($Config{ebcdic} eq 'define') {
     $_=join "", map chr($_), 129..233;
 
     # 105 characters - 52 letters = 53 backslashes
     # 105 characters + 53 backslashes = 158 characters
-    $_=quotemeta $_;
+    $_= quotemeta $_;
     if ( length == 158 ){print "ok 1\n"} else {print "not ok 1\n"}
     # 104 non-backslash characters
     if (tr/\\//cd == 104){print "ok 2\n"} else {print "not ok 2\n"}
@@ -22,7 +22,7 @@ if ($Config{ebcdic} eq 'define') {
 
     # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
     # 96 characters + 33 backslashes = 129 characters
-    $_=quotemeta $_;
+    $_= quotemeta $_;
     if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
     # 95 non-backslash characters
     if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
@@ -42,3 +42,6 @@ print "\Q\u\LpE.X.R\EL\E." eq "Pe\\.x\\.rL." ? "ok 12\n" : "not ok 12 \n";
 print "\Q\l\UPe*x*r\El\E*" eq "pE\\*X\\*Rl*" ? "ok 13\n" : "not ok 13 \n";
 print "\U\lPerl\E\E\E\E" eq "pERL" ? "ok 14\n" : "not ok 14 \n";
 print "\l\UPerl\E\E\E\E" eq "pERL" ? "ok 15\n" : "not ok 15 \n";
+
+print length(quotemeta("\x{263a}")) == 1 ? "ok 16\n" : "not ok 16\n";
+print quotemeta("\x{263a}") eq "\x{263a}" ? "ok 17\n" : "not ok 17\n";
diff --git a/t/op/substr.t b/t/op/substr.t
index a67eae56ac..f2a0c6c4fe 100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,10 +1,12 @@
+#!./perl
 
-print "1..130\n";
+print "1..135\n";
 
 #P = start of string  Q = start of substr  R = end of substr  S = end of string
 
 BEGIN {
-    unshift @INC, '../lib' if -d '../lib' ;
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
 }
 use warnings ;
 
@@ -269,15 +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) eq 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) eq 2;
+    ok 129, length($x) == 2;
     substr($x,0,1) = "abcd";
-    ok 129, $x eq "abcd\x{263a}";
-    ok 130, length($x) eq 5;
+    ok 130, $x eq "abcd\x{263a}";
+    ok 131, length($x) == 5;
+    $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";
 }
diff --git a/toke.c b/toke.c
index 6af744ce54..b7cceddbfb 100644
--- a/toke.c
+++ b/toke.c
@@ -819,7 +819,7 @@ Perl_str_to_version(pTHX_ SV *sv)
     NV nshift = 1.0;
     STRLEN len;
     char *start = SvPVx(sv,len);
-    bool utf = SvUTF8(sv);
+    bool utf = SvUTF8(sv) ? TRUE : FALSE;
     char *end = start + len;
     while (start < end) {
 	I32 skip;