In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/134b8cd8023b245ceceb96a0cb1a255bd3400f27?hp=730fb7e791962b4f698b07b82ae1213ced61a5e1>
- Log ----------------------------------------------------------------- commit 134b8cd8023b245ceceb96a0cb1a255bd3400f27 Author: Nicholas Clark <[email protected]> Date: Thu Jun 16 22:31:07 2011 +0200 Test studied scalars with s///ge. M pp_ctl.c M t/op/study.t commit bfafcb9a4c258bd72d8c22f5d8af5edc8897f48e Author: Nicholas Clark <[email protected]> Date: Wed Jun 15 13:05:11 2011 +0200 study now passes REXEC_SCREAM to the regex engine when SvSCREAM() is true. This causes the regex engine to take advantage of the study data. M pod/perldelta.pod M pp.c M t/op/study.t ----------------------------------------------------------------------- Summary of changes: pod/perldelta.pod | 5 +++++ pp.c | 2 +- pp_ctl.c | 7 +++++++ t/op/study.t | 26 +++++++++++++++++++++++++- 4 files changed, 38 insertions(+), 2 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 1964832..095785c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -71,6 +71,11 @@ may well be none in a stable release. The implementation of C<s///r> makes one fewer copy of the scalar's value. +=item * + +If a studied scalar is C<split> with a regex, the engine will now take +advantage of the C<study> data. + =back =head1 Modules and Pragmata diff --git a/pp.c b/pp.c index d3d4cc8..f815d0a 100644 --- a/pp.c +++ b/pp.c @@ -6152,7 +6152,7 @@ PP(pp_split) I32 rex_return; PUTBACK; rex_return = CALLREGEXEC(rx, (char*)s, (char*)strend, (char*)orig, 1 , - sv, NULL, 0); + sv, NULL, SvSCREAM(sv) ? REXEC_SCREAM : 0); SPAGAIN; if (rex_return == 0) break; diff --git a/pp_ctl.c b/pp_ctl.c index 0016484..8e53116 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -298,6 +298,13 @@ PP(pp_substcont) s -= RX_GOFS(rx); /* Are we done */ + /* I believe that we can't set REXEC_SCREAM here if + SvSCREAM(cx->sb_targ) is true because SvPVX(cx->sb_targ) isn't always + equal to s. [See the comment before Perl_re_intuit_start(), which is + called from Perl_regexec_flags(), which says that it should be when + SvSCREAM() is true.] s, cx->sb_strend and orig will be consistent + with SvPVX(cx->sb_targ), as substconst doesn't modify cx->sb_targ + during the match. */ if (CxONCE(cx) || s < orig || !CALLREGEXEC(rx, s, cx->sb_strend, orig, (s == m) + RX_GOFS(rx), cx->sb_targ, NULL, diff --git a/t/op/study.t b/t/op/study.t index 0e3ddb6..3733849 100644 --- a/t/op/study.t +++ b/t/op/study.t @@ -7,7 +7,7 @@ BEGIN { } watchdog(10); -plan(tests => 29); +plan(tests => 36); use strict; use vars '$x'; @@ -85,3 +85,27 @@ TODO: { ok(!/G.F$/, 'bug 20010618.006'); ok(!/[F]F$/, 'bug 20010618.006'); } + +{ + my $a = 'QaaQaabQaabbQ'; + study $a; + my @a = split /aab*/, $a; + is("@a", 'Q Q Q Q', 'split with studied string passed to the regep engine'); +} + +{ + $_ = "AABBAABB"; + study; + is(s/AB+/1/ge, 2, 'studied scalar passed to pp_substconst'); + is($_, 'A1A1'); +} + +{ + $_ = "AABBAABB"; + study; + is(s/(A)B+/1/ge, 2, + 'studied scalar passed to pp_substconst with RX_MATCH_COPIED() true'); + is($1, 'A'); + is($2, undef); + is($_, 'A1A1'); +} -- Perl5 Master Repository
