Re: [perl #18107] lc(), uc() and ucfirst() broken inside utf8 regex

Message-ID: <20021106193811.E20858@lustre.dyn.wiw.org>

p4raw-id: //depot/perl@18266

2 files changed, 33 insertions, 1 deletions

diff --git a/regcomp.c b/regcomp.c
index 50219d9a81..1f53655190 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5065,6 +5065,23 @@ Perl_save_re_context(pTHX)
     SAVEVPTR(PL_reg_curpm);		/* from regexec.c */
     SAVEI32(PL_regnpar);		/* () count. */
     SAVEI32(PL_regsize);		/* from regexec.c */
+
+    {
+	/* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
+	int i;
+	GV *mgv;
+	REGEXP *rx;
+	char digits[16];
+
+	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+	    for (i = 1; i <= rx->nparens; i++) {
+		sprintf(digits, "%lu", i);
+		if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV)))
+		    save_scalar(mgv);
+	    }
+	}
+    }
+
 #ifdef DEBUGGING
     SAVEPPTR(PL_reg_starttry);		/* from regexec.c */
 #endif
diff --git a/t/op/lc.t b/t/op/lc.t
index 1fbb3e1afb..8eef098de3 100644
--- a/t/op/lc.t
+++ b/t/op/lc.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..51\n";
+print "1..55\n";
 
 my $test = 1;
 
@@ -136,3 +136,18 @@ ok(ucfirst("\x{3C3}") eq "\x{3A3}", "U+03C3 ucfirst is U+03A3, too");
 ok(uc("\x{1C5}") eq "\x{1C4}",      "U+01C5 uc is U+01C4");
 ok(uc("\x{1C6}") eq "\x{1C4}",      "U+01C6 uc is U+01C4, too");
 
+# #18107: A host of bugs involving [ul]c{,first}. AMS 20021106
+$a = "\x{3c3}foo.bar"; # \x{3c3} == GREEK SMALL LETTER SIGMA.
+$b = "\x{3a3}FOO.BAR"; # \x{3a3} == GREEK CAPITAL LETTER SIGMA.
+
+($c = $b) =~ s/(\w+)/lc($1)/ge;
+ok($c eq $a, "Using s///e to change case.");
+
+($c = $a) =~ s/(\w+)/uc($1)/ge;
+ok($c eq $b, "Using s///e to change case.");
+
+($c = $b) =~ s/(\w+)/lcfirst($1)/ge;
+ok($c eq "\x{3c3}FOO.bAR", "Using s///e to change case.");
+
+($c = $a) =~ s/(\w+)/ucfirst($1)/ge;
+ok($c eq "\x{3a3}foo.Bar", "Using s///e to change case.");