summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2007-12-29 13:26:35 +0000
committerYves Orton <demerphq@gmail.com>2007-12-29 13:26:35 +0000
commit10300be4785857111b4e5614934a2d871b62b6ce (patch)
treee4192856866a649dad2fdd19fac7cacb765819cf
parent453d94a93e573c5979e959533fb269b76eb66968 (diff)
downloadperl-10300be4785857111b4e5614934a2d871b62b6ce.tar.gz
Fix Perl #49190, tests from Abigail, codefix from me.
p4raw-id: //depot/perl@32761
-rw-r--r--pp_hot.c10
-rwxr-xr-xt/op/pat.t13
2 files changed, 15 insertions, 8 deletions
diff --git a/pp_hot.c b/pp_hot.c
index 5cc80877cd..f987357bf8 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2035,6 +2035,7 @@ PP(pp_subst)
const I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
+ I32 matched;
#ifdef PERL_OLD_COPY_ON_WRITE
bool is_cow;
#endif
@@ -2121,7 +2122,8 @@ PP(pp_subst)
/* only replace once? */
once = !(rpm->op_pmflags & PMf_GLOBAL);
-
+ matched = CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
+ r_flags | REXEC_CHECKED);
/* known replacement string? */
if (dstr) {
/* replacement needing upgrading? */
@@ -2153,8 +2155,7 @@ PP(pp_subst)
&& (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR))
&& !(rx->extflags & RXf_LOOKBEHIND_SEEN)
&& (!doutf8 || SvUTF8(TARG))) {
- if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
- r_flags | REXEC_CHECKED))
+ if (!matched)
{
SPAGAIN;
PUSHs(&PL_sv_no);
@@ -2258,8 +2259,7 @@ PP(pp_subst)
RETURN;
}
- if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
- r_flags | REXEC_CHECKED))
+ if (matched)
{
if (force_on_match) {
force_on_match = 0;
diff --git a/t/op/pat.t b/t/op/pat.t
index 821e6526d5..26c4cb3f9c 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4511,13 +4511,20 @@ sub kt
}
}
}
-
{
my $a = 3; "" =~ /(??{ $a })/;
my $b = $a;
iseq($b, $a, "copy of scalar used for postponed subexpression");
}
-
+{
+ local $Message = "\$REGMARK in replacement -- Bug #49190";
+ my $_ = "A";
+ s/(*:B)A/$REGMARK/;
+ iseq $_, "B";
+ $_ = "CCCCBAA";
+ s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g;
+ iseq $_, "ZYX";
+}
# Test counter is at bottom of file. Put new tests above here.
#-------------------------------------------------------------------
# Keep the following tests last -- they may crash perl
@@ -4576,6 +4583,6 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
iseq(0+$::test,$::TestCount,"Got the right number of tests!");
# Don't forget to update this!
BEGIN {
- $::TestCount = 4014;
+ $::TestCount = 4016;
print "1..$::TestCount\n";
}