diff options
author | David Mitchell <davem@iabyn.com> | 2012-05-28 16:44:38 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2012-06-13 13:32:54 +0100 |
commit | 74088413856f71406615c6b1ae959e57f51d192a (patch) | |
tree | 6d63bba701a81661cb74eef12ced06efe3aa3275 /t/re/pat_re_eval.t | |
parent | ec43f78b9ed51e88c9f6dd2f2ce15db067e4049f (diff) | |
download | perl-74088413856f71406615c6b1ae959e57f51d192a.tar.gz |
save paren positions when running (?{}) code
Currently, all paren positions are saved before and after executing the
regops returned by (??{}); but not while the perl ops are being executed
beforehand. If the code happens to do a pattern match against the same
regex that's being currently run, then all iuts oparen positions will be
overwritten. So save them before entering the RUNOPS loop too.
Diffstat (limited to 't/re/pat_re_eval.t')
-rw-r--r-- | t/re/pat_re_eval.t | 84 |
1 files changed, 83 insertions, 1 deletions
diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t index 20dbf06984..338f5c2be0 100644 --- a/t/re/pat_re_eval.t +++ b/t/re/pat_re_eval.t @@ -23,7 +23,7 @@ BEGIN { } -plan tests => 434; # Update this when adding/deleting tests. +plan tests => 444; # Update this when adding/deleting tests. run_tests() unless caller; @@ -835,6 +835,88 @@ sub run_tests { recurse2(5); } + # nested (??{}) called from various levels of a recursive function + + { + sub recurse3 { + my ($n) = @_; + return if $n > 3; + ok("A$n" =~ m{^A(??{ "0123" =~ /((??{$n}))/; $1 })$}, + "recurse3($n)"); + ok("A$n" !~ m{^A(??{ "0123" =~ /((??{$n}))/; "X" })$}, + "recurse3($n) nomatch"); + recurse3($n+1); + } + recurse3(0); + } + + # nested (??{}) being invoked recursively via a function + + { + my $s = ''; + our $recurse4; + my @alpha = qw(A B C D E); + $recurse4 = sub { + my ($n) = @_; + $s .= "(n=$n:"; + if ($n < 4) { + my $m = ("$alpha[$n]" . substr("0123", 0, $n+1)) =~ + m{^([A-Z]) + (??{ + $s .= "1=$1:"; + "$n-0123" =~ m{^(\d)-(((??{$recurse4->($n+1)})))}; + $s .= "i1=$1:<=[$2]"; + $3; # NB - not stringified + }) + $ + }x; + $s .= "1a=$1:"; + $s .= $m ? 'M' : '!M'; + } + my $ret = '.*?' . ($n-1); + $s .= "<=[$ret])"; + return $ret; + }; + $recurse4->(0); + my $exp = '(n=0:1=A:(n=1:1=B:(n=2:1=C:(n=3:1=D:(n=4:<=[.*?3])' + . 'i1=3:<=[0123]1a=D:M<=[.*?2])i1=2:<=[012]1a=C:M<=[.*?1])' + . 'i1=1:<=[01]1a=B:M<=[.*?0])i1=0:<=[0]1a=A:M<=[.*?-1])'; + is($s, $exp, 'recurse4'); + } + + # single (??{}) being invoked recursively via a function + + { + my $s = ''; + our $recurse5; + my @alpha = qw(A B C D E); + $recurse5 = sub { + my ($n) = @_; + $s .= "(n=$n:"; + if ($n < 4) { + my $m = ("$alpha[$n]" . substr("0123", 0, $n+1)) =~ + m{^([A-Z]) + ((??{ + $s .= "1=$1:"; + $recurse5->($n+1); + })) + $ + }x; + $s .= "1a=$1:2=$2:"; + $s .= $m ? 'M' : '!M'; + } + my $ret = '.*?' . ($n-1); + $s .= "<=[$ret])"; + return $ret; + }; + $recurse5->(0); + my $exp = '(n=0:1=A:(n=1:1=B:(n=2:1=C:(n=3:1=D:(n=4:<=[.*?3])' + . '1a=D:2=0123:M<=[.*?2])1a=C:2=012:M<=[.*?1])' + . '1a=B:2=01:M<=[.*?0])1a=A:2=0:M<=[.*?-1])'; + is($s, $exp, 'recurse5'); + } + + # make sure that errors during compiling run-time code get trapped { |