Blob Blame Raw
--- perl-5.8.8/t/op/lc.t.U27329	2005-11-07 09:22:36.000000000 -0500
+++ perl-5.8.8/t/op/lc.t	2006-06-01 22:02:13.000000000 -0400
@@ -6,7 +6,7 @@
     require './test.pl';
 }
 
-plan tests => 59;
+plan tests => 77;
 
 $a = "HELLO.* world";
 $b = "hello.* WORLD";
@@ -163,3 +163,38 @@
 	is($a, v10, "[perl #18857]");
     } 
 }
+
+
+# [perl #38619] Bug in lc and uc (interaction between UTF-8, substr, and lc/uc)
+
+for ("a\x{100}", "xyz\x{100}") {
+    is(substr(uc($_), 0), uc($_), "[perl #38619] uc");
+}
+for ("A\x{100}", "XYZ\x{100}") {
+    is(substr(lc($_), 0), lc($_), "[perl #38619] lc");
+}
+for ("a\x{100}", "ßyz\x{100}") { # ß to Ss (different length)
+    is(substr(ucfirst($_), 0), ucfirst($_), "[perl #38619] ucfirst");
+}
+
+# Related to [perl #38619]
+# the original report concerns PERL_MAGIC_utf8.
+# these cases concern PERL_MAGIC_regex_global.
+
+for (map { $_ } "a\x{100}", "abc\x{100}", "\x{100}") {
+    chop; # get ("a", "abc", "") in utf8
+    my $return =  uc($_) =~ /\G(.?)/g;
+    my $result = $return ? $1 : "not";
+    my $expect = (uc($_) =~ /(.?)/g)[0];
+    is($return, 1,       "[perl #38619]");
+    is($result, $expect, "[perl #38619]");
+}
+
+for (map { $_ } "A\x{100}", "ABC\x{100}", "\x{100}") {
+    chop; # get ("A", "ABC", "") in utf8
+    my $return =  lc($_) =~ /\G(.?)/g;
+    my $result = $return ? $1 : "not";
+    my $expect = (lc($_) =~ /(.?)/g)[0];
+    is($return, 1,       "[perl #38619]");
+    is($result, $expect, "[perl #38619]");
+}
--- perl-5.8.8/pp.c.U27329	2006-06-01 21:30:14.000000000 -0400
+++ perl-5.8.8/pp.c	2006-06-01 21:53:37.000000000 -0400
@@ -3447,7 +3447,8 @@
 	    if (slen > ulen)
 	        sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
 	    SvUTF8_on(TARG);
-	    SETs(TARG);
+	    sv = TARG;
+	    SETs(sv);
 	}
 	else {
 	    s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3502,7 +3503,8 @@
 	    if (slen > ulen)
 	        sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
 	    SvUTF8_on(TARG);
-	    SETs(TARG);
+	    sv = TARG;
+	    SETs(sv);
 	}
 	else {
 	    s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3552,7 +3554,8 @@
 	if (!len) {
 	    SvUTF8_off(TARG);				/* decontaminate */
 	    sv_setpvn(TARG, "", 0);
-	    SETs(TARG);
+	    sv = TARG;
+	    SETs(sv);
 	}
 	else {
 	    STRLEN min = len + 1;
@@ -3585,7 +3588,8 @@
 	    *d = '\0';
 	    SvUTF8_on(TARG);
 	    SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
-	    SETs(TARG);
+	    sv = TARG;
+	    SETs(sv);
 	}
     }
     else {
@@ -3636,7 +3640,8 @@
 	if (!len) {
 	    SvUTF8_off(TARG);				/* decontaminate */
 	    sv_setpvn(TARG, "", 0);
-	    SETs(TARG);
+	    sv = TARG;
+	    SETs(sv);
 	}
 	else {
 	    STRLEN min = len + 1;
@@ -3688,7 +3693,8 @@
 	    *d = '\0';
 	    SvUTF8_on(TARG);
 	    SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
-	    SETs(TARG);
+	    sv = TARG;
+	    SETs(sv);
 	}
     }
     else {