#!/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