1*f2a19305Safresh1#!perl -w 2*f2a19305Safresh1 3*f2a19305Safresh1use strict; 4*f2a19305Safresh1use warnings; 5*f2a19305Safresh1use Test::More; 6*f2a19305Safresh1 7*f2a19305Safresh1use XS::APItest; 8*f2a19305Safresh1 9*f2a19305Safresh1my %ix; 10*f2a19305Safresh1sub showix { 11*f2a19305Safresh1 diag join ", ", map { $ix{$_} > 1 ? "$_ x $ix{$_}" : $_ } sort { $a <=> $b } keys %ix; 12*f2a19305Safresh1} 13*f2a19305Safresh1my $len = 100; 14*f2a19305Safresh1my $str= "a" x $len; 15*f2a19305Safresh1my $pat= join "|", map { "a" x $_ } 1 .. $len; 16*f2a19305Safresh1 17*f2a19305Safresh1$str=~/^($pat)(??{ $ix{get_savestack_ix()}++; "(?!)" })/; 18*f2a19305Safresh1my $keys= 0+keys %ix; 19*f2a19305Safresh1cmp_ok($keys,">",0, "We expect at least one key in %ix for (??{ ... }) test"); 20*f2a19305Safresh1cmp_ok($keys,"<=", 2, "We expect no more than two keys in %ix if (??{ ... }) does not leak") 21*f2a19305Safresh1 or showix(); 22*f2a19305Safresh1 23*f2a19305Safresh1%ix= (); 24*f2a19305Safresh1$str=~/^($pat)(?{ $ix{my $x=get_savestack_ix()}++; })(?!)/; 25*f2a19305Safresh1$keys= 0+keys %ix; 26*f2a19305Safresh1cmp_ok($keys,">",0, "We expect at least one key in %ix for (?{ ... }) test"); 27*f2a19305Safresh1cmp_ok($keys, "<=", 2, "We expect no more than two keys in %ix if (?{ ... }) does not leak") 28*f2a19305Safresh1 or showix(); 29*f2a19305Safresh1 30*f2a19305Safresh1%ix= (); 31*f2a19305Safresh1$str=~/^($pat)(?(?{ $ix{my $x=get_savestack_ix()}++; })x|y)(?!)/; 32*f2a19305Safresh1$keys= 0+keys %ix; 33*f2a19305Safresh1cmp_ok($keys,">",0, "We expect at least one key in %ix for (?(?{ ... })yes|no) test"); 34*f2a19305Safresh1cmp_ok($keys, "<=", 2, "We expect no more than two keys in %ix if (?(?{ ... })yes|no) does not leak") 35*f2a19305Safresh1 or showix(); 36*f2a19305Safresh1 37*f2a19305Safresh1done_testing(); 38