view release on metacpan or  search on metacpan

t/32leakcheck.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use CPS qw( kwhile );

if( $] < 5.008 ) {
   plan skip_all => "weaken() doesn't work before 5.8";
}

my $destroycount = 0;

my $poke;

{
   my $obj = DestroyCounter->new( \$destroycount );
   my $callcount = 0;

   kwhile(
      sub {
         my ( $knext, $klast ) = @_;

         $callcount++;

         # Just so this closure references the variable
         $obj = $obj;

         return $klast->() if $callcount == 3;

         $poke = $knext;
      },
      sub {
      }
   );
}

is( $destroycount, 0, 'Initially undestroyed' );

$poke->();

is( $destroycount, 0, 'Undestroyed after first poke' );

$poke->();
undef $poke;

is( $destroycount, 1, 'Destroyed after second poke' );

done_testing;

package DestroyCounter;

sub new
{
   my $class = shift;
   my ( $varref ) = @_;
   bless [ $varref ], $class;
}

sub DESTROY
{
   my $self = shift;
   ${ $self->[0] }++;
}