diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 9 | ||||
| -rw-r--r-- | ext/XS-APItest/t/savestack.t | 37 | ||||
| -rw-r--r-- | regexec.c | 7 |
4 files changed, 52 insertions, 2 deletions
@@ -4677,6 +4677,7 @@ ext/XS-APItest/t/refs.t Test typemap ref handling ext/XS-APItest/t/rmagical.t XS::APItest extension ext/XS-APItest/t/rv2cv_op_cv.t test rv2cv_op_cv() API ext/XS-APItest/t/savehints.t test SAVEHINTS() API +ext/XS-APItest/t/savestack.t test savestack behavior, currently only in the regex engine ext/XS-APItest/t/scopelessblock.t test recursive descent statement-sequence parsing ext/XS-APItest/t/sort.t Test sort(xs_cmp ...) ext/XS-APItest/t/stmtasexpr.t test recursive descent statement parsing diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index ff7667b24a..a7f1d5f011 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -7931,3 +7931,12 @@ newSvNV(const char * string) RETVAL = SvNV(newSVpv(string, 0)); OUTPUT: RETVAL + +MODULE = XS::APItest PACKAGE = XS::APItest::savestack + +IV +get_savestack_ix() + CODE: + RETVAL = PL_savestack_ix; + OUTPUT: + RETVAL diff --git a/ext/XS-APItest/t/savestack.t b/ext/XS-APItest/t/savestack.t new file mode 100644 index 0000000000..0e7d628e37 --- /dev/null +++ b/ext/XS-APItest/t/savestack.t @@ -0,0 +1,37 @@ +#!perl -w + +use strict; +use warnings; +use Test::More; + +use XS::APItest; + +my %ix; +sub showix { + diag join ", ", map { $ix{$_} > 1 ? "$_ x $ix{$_}" : $_ } sort { $a <=> $b } keys %ix; +} +my $len = 100; +my $str= "a" x $len; +my $pat= join "|", map { "a" x $_ } 1 .. $len; + +$str=~/^($pat)(??{ $ix{get_savestack_ix()}++; "(?!)" })/; +my $keys= 0+keys %ix; +cmp_ok($keys,">",0, "We expect at least one key in %ix for (??{ ... }) test"); +cmp_ok($keys,"<=", 2, "We expect no more than two keys in %ix if (??{ ... }) does not leak") + or showix(); + +%ix= (); +$str=~/^($pat)(?{ $ix{my $x=get_savestack_ix()}++; })(?!)/; +$keys= 0+keys %ix; +cmp_ok($keys,">",0, "We expect at least one key in %ix for (?{ ... }) test"); +cmp_ok($keys, "<=", 2, "We expect no more than two keys in %ix if (?{ ... }) does not leak") + or showix(); + +%ix= (); +$str=~/^($pat)(?(?{ $ix{my $x=get_savestack_ix()}++; })x|y)(?!)/; +$keys= 0+keys %ix; +cmp_ok($keys,">",0, "We expect at least one key in %ix for (?(?{ ... })yes|no) test"); +cmp_ok($keys, "<=", 2, "We expect no more than two keys in %ix if (?(?{ ... })yes|no) does not leak") + or showix(); + +done_testing(); @@ -8072,7 +8072,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) CV *newcv; /* save *all* paren positions */ - regcppush(rex, 0, maxopenparen); + ST.cp = regcppush(rex, 0, maxopenparen); REGCP_SET(ST.lastcp); if (!caller_cv) @@ -8349,9 +8349,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) EVAL_CLOSE_PAREN_CLEAR(st); /* ST.close_paren = 0; * close_paren only for GOSUB */ ST.prev_recurse_locinput= NULL; /* only used for GOSUB */ - /* Save all the seen positions so far. */ + + /* note we saved the paren state earlier: ST.cp = regcppush(rex, 0, maxopenparen); REGCP_SET(ST.lastcp); + */ /* and set maxopenparen to 0, since we are starting a "fresh" match */ maxopenparen = 0; /* run the pattern returned from (??{...}) */ @@ -8441,6 +8443,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) case EVAL_B_fail: /* unsuccessful B in (?{...})B */ REGCP_UNWIND(ST.lastcp); + regcppop(rex, &maxopenparen); sayNO; case EVAL_postponed_AB_fail: /* unsuccessfully ran A or B in (??{A})B */ |