File Coverage

blib/lib/Devel/MAT/Tool/Roots.pm
Criterion Covered Total %
statement 17 24 70.8
branch 0 4 0.0
condition n/a
subroutine 6 7 85.7
pod 0 1 0.0
total 23 36 63.8


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2017 -- leonerd@leonerd.org.uk
5              
6             package Devel::MAT::Tool::Roots 0.49;
7              
8 4     4   2320 use v5.14;
  4         12  
9 4     4   18 use warnings;
  4         17  
  4         99  
10 4     4   17 use base qw( Devel::MAT::Tool );
  4         8  
  4         336  
11              
12 4     4   22 use List::Util qw( pairs );
  4         17  
  4         216  
13              
14 4     4   20 use constant CMD => "roots";
  4         11  
  4         221  
15 4     4   27 use constant CMD_DESC => "Display a list of the root SVs";
  4         9  
  4         745  
16              
17             =head1 NAME
18              
19             C - display a list of the root SVs
20              
21             =head1 DESCRIPTION
22              
23             This C tool displays a list of all the root SVs.
24              
25             =cut
26              
27             =head1 COMMANDS
28              
29             =head2 roots
30              
31             pmat> roots
32             the *@ GV : GLOB($*) at 0x1381ed0/errgv
33             the ARGV GV : GLOB(@*I) at 0x139f618/argvgv
34             ...
35              
36             Prints a list of every root SV in the heap.
37              
38             =cut
39              
40             sub run
41             {
42 0     0 0   my $self = shift;
43              
44 0           my $df = $self->df;
45              
46             Devel::MAT::Cmd->print_table(
47             [ map {
48 0           my ( $name, $description ) = @$_;
  0            
49 0           my $addr = $df->root_at( $name );
50 0           my $sv = $df->sv_at( $addr );
51              
52 0 0         $sv ? [ "$description", Devel::MAT::Cmd->format_sv( $sv ) ] :
    0          
53             $addr ? [ "$description", sprintf( "PTR(0x%x)", $addr ) ] :
54             ()
55             } pairs $df->root_descriptions ],
56             sep => ": ",
57             );
58             }
59              
60             =head1 AUTHOR
61              
62             Paul Evans
63              
64             =cut
65              
66             0x55AA;