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;
use Fatal qw(open close);

BEGIN {
  unless ($] >= 5.008) {
    plan skip_all => 'due to test code no good for 5.006 yet';
  }
  plan tests => 2;
}

use lib 't/lib';
use Test::Weaken::Test;

BEGIN { Test::More::use_ok('Test::Weaken') }

## no critic (InputOutput::RequireBriefOpen)
open my $save_stdout, '>&STDOUT';
## use critic

close STDOUT;
my $code_output;
open STDOUT, q{>}, \$code_output;

## use Marpa::Test::Display synopsis

use Test::Weaken qw(leaks);
use Data::Dumper;
use Math::BigInt;
use Math::BigFloat;
use Carp;
use English qw( -no_match_vars );

my $good_test = sub {
    my $obj1 = Math::BigInt->new('42');
    my $obj2 = Math::BigFloat->new('7.11');
    [ $obj1, $obj2 ];
};

if ( !leaks($good_test) ) {
    print "No leaks in test 1\n"
        or Carp::croak("Cannot print to STDOUT: $ERRNO");
}
else {
    print "There were memory leaks from test 1!\n"
        or Carp::croak("Cannot print to STDOUT: $ERRNO");
}

my $bad_test = sub {
    my $array = [ 42, 711 ];
    push @{$array}, $array;
    $array;
};

my $bad_destructor = sub {'I am useless'};

my $tester = Test::Weaken::leaks(
    {   constructor => $bad_test,
        destructor  => $bad_destructor,
    }
);
if ($tester) {
    my $unfreed_proberefs = $tester->unfreed_proberefs();
    my $unfreed_count     = @{$unfreed_proberefs};
    printf "Test 2: %d of %d original references were not freed\n",
        $tester->unfreed_count(), $tester->probe_count()
        or Carp::croak("Cannot print to STDOUT: $ERRNO");
    print "These are the probe references to the unfreed objects:\n"
        or Carp::croak("Cannot print to STDOUT: $ERRNO");
    for my $ix ( 0 .. $#{$unfreed_proberefs} ) {
        print Data::Dumper->Dump( [ $unfreed_proberefs->[$ix] ],
            ["unfreed_$ix"] )
            or Carp::croak("Cannot print to STDOUT: $ERRNO");
    }
}

## no Marpa::Test::Display

open STDOUT, q{>&}, $save_stdout;

Test::Weaken::Test::is( $code_output, <<'EOS', 'synopsis output' );
No leaks in test 1
Test 2: 4 of 5 original references were not freed
These are the probe references to the unfreed objects:
$unfreed_0 = [
               42,
               711,
               $unfreed_0
             ];
$unfreed_1 = \42;
$unfreed_2 = \711;
$unfreed_3 = \[
                 42,
                 711,
                 ${$unfreed_3}
               ];
EOS