Skip to content

Commit ada6e8a

Browse files
Abhijit Menon-Senhvds
Abhijit Menon-Sen
authored andcommitted
Re: [perl #18107] lc(), uc() and ucfirst() broken inside utf8 regex
Message-ID: <[email protected]> p4raw-id: //depot/perl@18266
1 parent 3b9d212 commit ada6e8a

File tree

2 files changed

+33
-1
lines changed

2 files changed

+33
-1
lines changed

regcomp.c

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5065,6 +5065,23 @@ Perl_save_re_context(pTHX)
50655065
SAVEVPTR(PL_reg_curpm); /* from regexec.c */
50665066
SAVEI32(PL_regnpar); /* () count. */
50675067
SAVEI32(PL_regsize); /* from regexec.c */
5068+
5069+
{
5070+
/* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
5071+
int i;
5072+
GV *mgv;
5073+
REGEXP *rx;
5074+
char digits[16];
5075+
5076+
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
5077+
for (i = 1; i <= rx->nparens; i++) {
5078+
sprintf(digits, "%lu", i);
5079+
if ((mgv = gv_fetchpv(digits, FALSE, SVt_PV)))
5080+
save_scalar(mgv);
5081+
}
5082+
}
5083+
}
5084+
50685085
#ifdef DEBUGGING
50695086
SAVEPPTR(PL_reg_starttry); /* from regexec.c */
50705087
#endif

t/op/lc.t

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#!./perl
22

3-
print "1..51\n";
3+
print "1..55\n";
44

55
my $test = 1;
66

@@ -136,3 +136,18 @@ ok(ucfirst("\x{3C3}") eq "\x{3A3}", "U+03C3 ucfirst is U+03A3, too");
136136
ok(uc("\x{1C5}") eq "\x{1C4}", "U+01C5 uc is U+01C4");
137137
ok(uc("\x{1C6}") eq "\x{1C4}", "U+01C6 uc is U+01C4, too");
138138

139+
# #18107: A host of bugs involving [ul]c{,first}. AMS 20021106
140+
$a = "\x{3c3}foo.bar"; # \x{3c3} == GREEK SMALL LETTER SIGMA.
141+
$b = "\x{3a3}FOO.BAR"; # \x{3a3} == GREEK CAPITAL LETTER SIGMA.
142+
143+
($c = $b) =~ s/(\w+)/lc($1)/ge;
144+
ok($c eq $a, "Using s///e to change case.");
145+
146+
($c = $a) =~ s/(\w+)/uc($1)/ge;
147+
ok($c eq $b, "Using s///e to change case.");
148+
149+
($c = $b) =~ s/(\w+)/lcfirst($1)/ge;
150+
ok($c eq "\x{3c3}FOO.bAR", "Using s///e to change case.");
151+
152+
($c = $a) =~ s/(\w+)/ucfirst($1)/ge;
153+
ok($c eq "\x{3a3}foo.Bar", "Using s///e to change case.");

0 commit comments

Comments
 (0)