The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;
use warnings;
use Test::More tests => 1;

sub extract_more_from {
  return;
}
sub some_condition {
  return 0;
}


#------------------------------------------------------------------------------

 use Test::Weaken qw(leaks);
 my $leaks = leaks(sub {
                    my $obj = { one => 1,
                                two => [],
                                three => [3,3,3] };
                    return $obj;
                   });
 if ($leaks) {
     print "There were memory leaks from test 1!\n";
     printf "%d of %d original references were not freed\n",
         $leaks->unfreed_count(), $leaks->probe_count();
 } else {
     print "No leaks in test 1\n";
 }

 $leaks = Test::Weaken::leaks(
    { constructor => sub {
        my @array = (42, 711);
        push @array, \@array;  # circular reference
        return \@array;
      },
      destructor  => sub {
        print "This could invoke an object destructor\n";
      },
      ignore  => sub {
        my ($ref) = @_;
        if (some_condition($ref)) {
          return 1;  # ignore
        }
        return 0; # don't ignore
      },
      contents  => sub {
        my ($ref) = @_;
        return extract_more_from($ref);
      },
    });
 if ($leaks) {
     print "There were memory leaks from test 2!\n";
     my $unfreed_proberefs = $leaks->unfreed_proberefs();
     print "These are the probe references to the unfreed objects:\n";
     require Data::Dumper;
     foreach my $ref (@$unfreed_proberefs) {
         print "ref $ref\n";
         print Data::Dumper->Dump([$ref], ['unfreed']);
     }
 }

#------------------------------------------------------------------------------

ok(1);
exit 0;