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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
my ( $URL, $REQUEST_COUNT, %tolerance, $expected_leaks );
my $leaks = 0;
=head1 Methods
=head2 BEGIN
See if we have modules necessary for testing. Set arguments.
=cut
sub BEGIN {
$URL = $ARGV[0] || '/';
$REQUEST_COUNT = $ARGV[1] || 1;
$ENV{CATALYST_CONFIG} = 't/var/mojomojo.yml';
eval 'use Devel::LeakGuard::Object qw(leakguard leakstate)';
plan skip_all => 'need Devel::LeakGuard::Object' if $@;
eval "use Catalyst::Test 'MojoMojo'";
plan skip_all => 'need Catalyst::Test' if $@;
plan tests => 2;
}
=head2 Class Tolerance Threshold Hash
This is the Control Interface as to what we will tolerate.
The key is a class name and the value represents the
maximum number of objects you allow to leak from the class.
=cut
%tolerance = (
'MojoMojo::I18N::i_default' => 1,
'MojoMojo::I18N::en' => 1,
);
=pod
Build a proper data structure for C<expect> which takes a range.
An example is:
'MojoMojo::I18N::en' => [ 0, 1 ]
This says we'll tolerate between 0 and 1 objects leaking
from the class MojoMojo::I18N::en.
=cut
foreach my $class (keys %tolerance) {
my $tolerance_range = [0]; # start at zero
$tolerance_range->[1] = $tolerance{$class};
$expected_leaks->{$class} = $tolerance_range;
}
=pod
Make first request. Things like Moose will have objects persist
for the duration of the process. Get those into the memory space
before testing for leaks.
=cut
ok( request($URL)->is_success, 'First Request' );
=pod
Here is where we wrap the code to be tested with the leakguard method.
=cut
leakguard {
request($URL) for 1 .. $REQUEST_COUNT;
}
expect => $expected_leaks;
=head2 on_leak
When there is a object memory leak this anonymous sub will be run.
Would like to use on_leak(), but when I combined it with expect I got:
Useless use of a constant in void context
Useless use of reference constructor in void context
An alternative approach using C<leakstate()> has been implemented.
=cut
my %nonzero_report;
my %report_hash = %{ leakstate() };
foreach my $class ( keys %report_hash ) {
# Do we have non-zero objects reported for a class
if ( my $object_count = $report_hash{$class} > 0 ) {
# Do we care if there are non-zero objects of smaller values.
if ( $object_count > $tolerance{$class} ) {
$nonzero_report{$class} = $report_hash{$class};
$leaks++;
}
}
}
use Data::Dumper;
print Dumper %nonzero_report;
is( $leaks, 0, 'Object Memory Management' );
|
