diff options
Diffstat (limited to 'ext')
-rw-r--r-- | ext/XS-APItest/APItest.xs | 9 | ||||
-rw-r--r-- | ext/XS-APItest/t/savestack.t | 37 |
2 files changed, 46 insertions, 0 deletions
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(); |