This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [perl #18107] lc(), uc() and ucfirst() broken inside utf8 regex
authorAbhijit Menon-Sen <ams@wiw.org>
Wed, 6 Nov 2002 19:38:11 +0000 (01:08 +0530)
committerhv <hv@crypt.org>
Mon, 9 Dec 2002 00:02:57 +0000 (00:02 +0000)
Message-ID: <20021106193811.E20858@lustre.dyn.wiw.org>

p4raw-id: //depot/perl@18266

regcomp.c
t/op/lc.t

index 50219d9..1f53655 100644 (file)
--- 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
index 1fbb3e1..8eef098 100644 (file)
--- 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.");