File Coverage

blib/lib/Devel/Gladiator.pm
Criterion Covered Total %
statement 12 27 44.4
branch 0 4 0.0
condition n/a
subroutine 4 6 66.6
pod 2 2 100.0
total 18 39 46.1


line stmt bran cond sub pod time code
1 2     2   140392 use strict;
  2         21  
  2         62  
2 2     2   11 use warnings;
  2         4  
  2         116  
3             package Devel::Gladiator; # git description: v0.07-22-g8e8e311
4             # ABSTRACT: Walk Perl's arena
5             # KEYWORDS: development debugging memory allocation usage leaks cycles arena
6              
7             our $VERSION = '0.08';
8              
9 2     2   14 use base 'Exporter';
  2         2  
  2         838  
10              
11             our %EXPORT_TAGS = ( 'all' => [ qw(
12             walk_arena arena_ref_counts arena_table
13             ) ] );
14              
15             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
16              
17             sub arena_ref_counts {
18 0     0 1   my $all = Devel::Gladiator::walk_arena();
19 0           my %ct;
20 0           foreach my $it (@$all) {
21 0           $ct{ref $it}++;
22 0 0         if (ref $it eq "REF") {
23 0           $ct{"REF-" . ref $$it}++;
24             }
25             }
26 0           $all = undef;
27 0           return \%ct;
28             }
29              
30             sub arena_table {
31 0     0 1   my $ct = arena_ref_counts();
32 0           my $ret;
33 0           $ret .= "ARENA COUNTS:\n";
34 0 0         foreach my $k (sort { $ct->{$b} <=> $ct->{$a} || $a cmp $b } keys %$ct) {
  0            
35 0           $ret .= sprintf(" %4d $k\n", $ct->{$k});
36             }
37 0           return $ret;
38             }
39              
40 2     2   15 use XSLoader;
  2         4  
  2         117  
41             XSLoader::load(
42             __PACKAGE__,
43             $VERSION,
44             );
45              
46             1;
47              
48             __END__