summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/XS-APItest/APItest.xs9
-rw-r--r--ext/XS-APItest/t/savestack.t37
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();