diff options
| author | Yves Orton <demerphq@gmail.com> | 2023-01-09 22:34:13 +0100 |
|---|---|---|
| committer | Yves Orton <demerphq@gmail.com> | 2023-03-13 21:26:08 +0800 |
| commit | acababb42be12ff2986b73c1bfa963b70bb5d54e (patch) | |
| tree | dc8cc4980e6fe3de0c686cc641dbbe37d1e8e961 /regcomp_debug.c | |
| parent | 05b13cf680588a26de64f13d2b3be385e17624bc (diff) | |
| download | perl-acababb42be12ff2986b73c1bfa963b70bb5d54e.tar.gz | |
regexec.c - teach BRANCH and BRANCHJ nodes to reset capture buffers
In /((a)(b)|(a))+/ we should not end up with $2 and $4 being set at
the same time. When a branch fails it should reset any capture buffers
that might be touched by its branch.
We change BRANCH and BRANCHJ to store the number of parens before the
branch, and the number of parens after the branch was completed. When
a BRANCH operation fails, we clear the buffers it contains before we
continue on.
It is a bit more complex than it should be because we have BRANCHJ
and BRANCH. (One of these days we should merge them together.)
This is also made somewhat more complex because TRIE nodes are actually
branches, and may need to track capture buffers also, at two levels.
The overall TRIE op, and for jump tries especially where we emulate
the behavior of branches. So we have to do the same clearing logic if
a trie branch fails as well.
Diffstat (limited to 'regcomp_debug.c')
| -rw-r--r-- | regcomp_debug.c | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/regcomp_debug.c b/regcomp_debug.c index 6410f5e2da..bfa5370662 100644 --- a/regcomp_debug.c +++ b/regcomp_debug.c @@ -408,8 +408,13 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ sv_catpv(sv, REGNODE_NAME(op)); /* Take off const! */ k = REGNODE_TYPE(op); - - if (k == EXACT) { + if (op == BRANCH) { + Perl_sv_catpvf(aTHX_ sv, " (buf:%" IVdf "/%" IVdf ")", (IV)ARGa(o),(IV)ARGb(o)); + } + else if (op == BRANCHJ) { + Perl_sv_catpvf(aTHX_ sv, " (buf:%" IVdf "/%" IVdf ")", (IV)ARG2La(o),(IV)ARG2Lb(o)); + } + else if (k == EXACT) { sv_catpvs(sv, " "); /* Using is_utf8_string() (via PERL_PV_UNI_DETECT) * is a crude hack but it may be the best for now since @@ -462,6 +467,9 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ ); sv_catpvs(sv, "]"); } + if (trie->before_paren || trie->after_paren) + Perl_sv_catpvf(aTHX_ sv, " (buf:%" IVdf "/%" IVdf ")", + (IV)trie->before_paren,(IV)trie->after_paren); } else if (k == CURLY) { U32 lo = ARG1(o), hi = ARG2(o); if (ARG3(o) || ARG4(o)) |