diff options
| -rw-r--r-- | regexec.c | 10 | ||||
| -rwxr-xr-x | t/op/pat.t | 46 | ||||
| -rwxr-xr-x | t/op/subst.t | 11 | ||||
| -rw-r--r-- | win32/Makefile | 2 |
4 files changed, 63 insertions, 6 deletions
@@ -3867,7 +3867,15 @@ NULL } case CURLYX_end: /* just finished matching all of A*B */ - regcpblow(ST.cp); + if (PL_reg_eval_set){ + SV *pres= GvSV(PL_replgv); + SvREFCNT_inc(pres); + regcpblow(ST.cp); + sv_setsv(GvSV(PL_replgv), pres); + SvREFCNT_dec(pres); + } else { + regcpblow(ST.cp); + } cur_curlyx = ST.prev_curlyx; sayYES; /* NOTREACHED */ diff --git a/t/op/pat.t b/t/op/pat.t index 5ab10d062c..68328f8212 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -12,6 +12,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; } +our $Message = "Line"; eval 'use Config'; # Defaults assumed if this fails @@ -2037,7 +2038,8 @@ $test = 687; sub ok ($;$) { my($ok, $name) = @_; - printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed'; + printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, + $name||"$Message:".((caller)[2]); printf "# Failed test at line %d\n", (caller)[2] unless $ok; @@ -3673,7 +3675,8 @@ sub iseq($$;$) { my $ok= $got eq $expect; - printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed'; + printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, + $name||"$Message:".((caller)[2]); printf "# Failed test at line %d\n". "# expected: %s\n". @@ -3973,6 +3976,7 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) { } { # Test named commits and the $REGERROR var + local $Message = "\$REGERROR"; our $REGERROR; for $word (qw(bar baz bop)) { $REGERROR=""; @@ -3981,6 +3985,7 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) { } } { #Regression test for perlbug 40684 + local $Message = "RT#40684 tests:"; my $s = "abc\ndef"; my $rex = qr'^abc$'m; ok($s =~ m/$rex/); @@ -3994,6 +3999,7 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) { } { + local $Message = "Relative Recursion"; my $parens=qr/(\((?:[^()]++|(?-1))*+\))/; local $_='foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))'; my ($all,$one,$two)=('','',''); @@ -4015,6 +4021,39 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) { iseq($_,$spaces,"SUSPEND final string"); iseq($count,1,"Optimiser should have prevented more than one match"); } +{ + local $Message = "RT#36909 test"; + $^R = 'Nothing'; + { + local $^R = "Bad"; + ok('x foofoo y' =~ m{ + (foo) # $^R correctly set + (?{ "last regexp code result" }) + }x); + iseq($^R,'last regexp code result'); + } + iseq($^R,'Nothing'); + { + local $^R = "Bad"; + + ok('x foofoo y' =~ m{ + (?:foo|bar)+ # $^R correctly set + (?{"last regexp code result"}) + }x); + iseq($^R,'last regexp code result'); + } + iseq($^R,'Nothing'); + + { + local $^R = "Bad"; + ok('x foofoo y' =~ m{ + (foo|bar)\1+ # $^R undefined + (?{"last regexp code result"}) + }x); + iseq($^R,'last regexp code result'); + } + iseq($^R,'Nothing'); +} # Test counter is at bottom of file. Put new tests above here. #------------------------------------------------------------------- @@ -4046,6 +4085,7 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/, or print "# Unexpected outcome: should pass or crash perl\n"; { + local $Message = "substituation with lookahead (possible segv)"; $_="ns1ns1ns1"; s/ns(?=\d)/ns_/g; iseq($_,"ns_1ns_1ns_1"); @@ -4060,4 +4100,4 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/, # Put new tests above the dotted line about a page above this comment # Don't forget to update this! -BEGIN { print "1..1349\n" }; +BEGIN { print "1..1358\n" }; diff --git a/t/op/subst.t b/t/op/subst.t index 0b02ff93f4..d6e5f51123 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -7,7 +7,7 @@ BEGIN { } require './test.pl'; -plan( tests => 133 ); +plan( tests => 134 ); $x = 'foo'; $_ = "x"; @@ -562,4 +562,13 @@ is($name, "cis", q[#22351 bug with 'e' substitution modifier]); ($c = "\x20\x00\x30\x01\x40\x1A\x50\x1F\x60") =~ s/[\x00-\x1f]//g; is($c, "\x20\x30\x40\x50\x60", "s/[\\x00-\\x1f]//g"); } +TODO:{ + local $TODO = "RT#6006 needs resolution"; + $TODO=$TODO; + $_ = "xy"; + no warnings 'uninitialized'; + /(((((((((x)))))))))(z)/; # clear $10 + s/(((((((((x)))))))))(y)/${10}/; + is($_,"y","RT#6006: \$_ eq '$_'"); +} diff --git a/win32/Makefile b/win32/Makefile index 99ca522d16..87b111cede 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1363,7 +1363,7 @@ test-reonly : reonly utils $(XCOPY) $(PERLDLL) ..\t\$(NULL) $(XCOPY) $(GLOBEXE) ..\t\$(NULL) cd ..\t - $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b $(EXTRA) + $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b \bsubst $(EXTRA) cd ..\win32 regen : |