1*5759b3d2Safresh1#!/usr/bin/perl 2*5759b3d2Safresh1 3*5759b3d2Safresh1use warnings; 4*5759b3d2Safresh1use strict; 5*5759b3d2Safresh1 6*5759b3d2Safresh1use Test::More; 7*5759b3d2Safresh1 8*5759b3d2Safresh1eval { require XS::APItest; XS::APItest->import('sv_count'); 1 } 9*5759b3d2Safresh1 or plan skip_all => "No XS::APItest::sv_count() available"; 10*5759b3d2Safresh1 11*5759b3d2Safresh1plan tests => 1; 12*5759b3d2Safresh1 13*5759b3d2Safresh1sub leak { 14*5759b3d2Safresh1 my ($n, $delta, $code, $name) = @_; 15*5759b3d2Safresh1 my $sv0 = 0; 16*5759b3d2Safresh1 my $sv1 = 0; 17*5759b3d2Safresh1 for my $i (1..$n) { 18*5759b3d2Safresh1 &$code(); 19*5759b3d2Safresh1 $sv1 = sv_count(); 20*5759b3d2Safresh1 $sv0 = $sv1 if $i == 1; 21*5759b3d2Safresh1 } 22*5759b3d2Safresh1 cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, $name); 23*5759b3d2Safresh1} 24*5759b3d2Safresh1 25*5759b3d2Safresh1# [perl #129788] IO::Poll shouldn't leak on errors 26*5759b3d2Safresh1{ 27*5759b3d2Safresh1 package io_poll_leak; 28*5759b3d2Safresh1 use IO::Poll; 29*5759b3d2Safresh1 30*5759b3d2Safresh1 sub TIESCALAR { bless {} } 31*5759b3d2Safresh1 sub FETCH { die } 32*5759b3d2Safresh1 33*5759b3d2Safresh1 tie(my $a, __PACKAGE__); 34*5759b3d2Safresh1 sub f {eval { IO::Poll::_poll(0, $a, 1) }} 35*5759b3d2Safresh1 36*5759b3d2Safresh1 ::leak(5, 0, \&f, q{IO::Poll::_poll shouldn't leak}); 37*5759b3d2Safresh1} 38