diff options
| author | Yves Orton <demerphq@gmail.com> | 2016-03-14 23:30:02 +0100 |
|---|---|---|
| committer | Yves Orton <demerphq@gmail.com> | 2016-03-15 00:31:59 +0100 |
| commit | ce12e2548182b5bf6788188c520311eef0eca0ca (patch) | |
| tree | d54b37ab4e01b03128d27930121451b710d935c6 /t | |
| parent | 595de7616f5ea9813e28dc502de1c480ef2a5a97 (diff) | |
| download | perl-ce12e2548182b5bf6788188c520311eef0eca0ca.tar.gz | |
fix "bad match" issue reported in perl #127705
In 24be310237a0f8f19cfdb71de1b068b4ce9572a0 I reworked how
we stored the close_paren info in the regexp match state
structure. Unfortunately I missed a subtle aspect of the
logic which meant that in certain cases we were relying
on close_paren being true to avoid comparing it against
a false ARG value for things like CURLYX, which meant that
sometimes we would exit an stack frame prematurely. This
patch fixes that logic and makes it more clear (via macros)
what is going on.
Diffstat (limited to 't')
| -rw-r--r-- | t/re/pat.t | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/t/re/pat.t b/t/re/pat.t index 2a356ef5c9..295a9f7138 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -23,7 +23,7 @@ BEGIN { skip_all_without_unicode_tables(); } -plan tests => 785; # Update this when adding/deleting tests. +plan tests => 789; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1724,7 +1724,6 @@ EOP { my $bug="[perl #126182]"; # test for infinite pattern recursion for my $tuple ( - [ 'q(a)=~/(.(?2))((?<=(?=(?1)).))/', "died", "look ahead left recursion fails fast" ], [ 'q(aa)=~/(?R)a/', "died", "left-recursion fails fast", ], [ 'q(bbaa)=~/(?&x)(?(DEFINE)(?<x>(?&y)*a)(?<y>(?&x)*b))/', @@ -1736,14 +1735,24 @@ EOP [ 'q(abc) =~ /a((?1){0,3})c/', "died", "{0,3} left recursion fails fast" ], [ 'q(aaabbb)=~/a(?R)?b/', "matched", "optional self recursion works" ], + [ '"((5maa-maa)(maa-3maa))" =~ /(\\\\((?:[^()]++|(?0))*+\\\\))/', "matched", + "recursion and possessive captures", "((5maa-maa)(maa-3maa))"], + [ '"((5maa-maa)(maa-3maa))" =~ /(\\\\((?:[^()]++|(?1))*+\\\\))/', "matched", + "recursion and possessive captures", "((5maa-maa)(maa-3maa))"], + [ '"((5maa-maa)(maa-3maa))" =~ /(\\\\((?:[^()]+|(?0))*\\\\))/', "matched", + "recursion and possessive captures", "((5maa-maa)(maa-3maa))"], + [ '"((5maa-maa)(maa-3maa))" =~ /(\\\\((?:[^()]+|(?1))*\\\\))/', "matched", + "recursion and possessive captures", "((5maa-maa)(maa-3maa))"], ) { - my ($expr, $expect, $test_name)= @$tuple; + my ($expr, $expect, $test_name, $cap1)= @$tuple; # avoid quotes in this code! my $code=' BEGIN{require q(test.pl);} watchdog(3); - my $status= eval(qq{ (' . $expr . ') ? q(matched) : q(failed) }) - || ( ( $@ =~ /Infinite recursion/ ) ? q(died) : q(strange-death) ); + my $status= eval(q{ !(' . $expr . ') ? q(failed) : ' . + ($cap1 ? '($1 ne q['.$cap1.']) ? qq(badmatch:$1) : ' : '') . + ' q(matched) }) + || ( ( $@ =~ /Infinite recursion/ ) ? qq(died) : q(strange-death) ); print $status; '; fresh_perl_is($code, $expect, {}, "$bug - $test_name" ); |