1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use List::Util qw( pairgrep );
use Scalar::Util qw( weaken );
use Devel::MAT::Dumper;
use Devel::MAT;
my $DUMPFILE = __FILE__ =~ s/\.t/\.pmat/r;
# Set up a reference cycle with an easy-to-find PV in it
# Run this from an anonymous sub so we know the lexical is dropped
do {
my $av = [ undef, "This is" ];
$av->[0] = $av;
$av->[1] .= " a cycle";
undef $av;
};
# It might still be in the temp SV; try to overwrite it
my $tmp = [];
$tmp->[0] = 0;
undef $tmp;
Devel::MAT::Dumper::dump( $DUMPFILE );
END { unlink $DUMPFILE; }
my $pmat = Devel::MAT->load( $DUMPFILE );
ok( scalar( grep { $_ eq "Reachability" } $pmat->available_tools ), 'Reachability tool is available' );
$pmat->load_tool( "Reachability" );
my $df = $pmat->dumpfile;
{
my $defstash = $df->defstash;
ok( $defstash->reachable, 'Default stash is reachable' );
my $dump = $pmat->find_symbol( "&Devel::MAT::Dumper::dump" );
ok( $dump->reachable, '&Devel::MAT::Dumper::dump is reachable' );
}
SKIP: {
my @pvs = grep { $_->desc eq "SCALAR(P)" and $_->pv eq join " ", qw( This is a cycle ) } $df->heap;
skip "Could not find SCALAR(P) containing 'This is a cycle'", 1 unless @pvs;
skip "Could not uniquely identify the PV in the cyclic leak AV", 1 unless @pvs == 1;
my ( $pv ) = @pvs;
ok( !$pv->reachable, "'This is a cycle' PV is not reachable" );
if( $pv->reachable ) {
diag( "PV is:" );
diag( $_ ) for $pmat->identify( $pv );
}
}
done_testing;
|
