Commit | Line | Data |
7c40a30f |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use FindBin; |
a2e038a1 |
7 | use lib "$FindBin::Bin/lib"; |
7c40a30f |
8 | |
9 | use Test::More; |
10 | use Catalyst::Test 'TestApp'; |
7c40a30f |
11 | |
12 | plan skip_all => 'set TEST_MEMLEAK to enable this test' |
13 | unless $ENV{TEST_MEMLEAK}; |
15f0ede8 |
14 | |
15 | eval "use Proc::ProcessTable"; |
9b984642 |
16 | plan skip_all => 'Proc::ProcessTable required for this test' if $@; |
7c40a30f |
17 | |
3eca4f18 |
18 | eval "use HTTP::Body 0.03"; |
19 | plan skip_all => 'HTTP::Body >= 0.03 required for this test' if $@; |
20 | |
15f0ede8 |
21 | eval "use YAML"; |
22 | plan skip_all => 'YAML required for this test' if $@; |
23 | |
9b984642 |
24 | our $t = Proc::ProcessTable->new( cache_ttys => 1 ); |
010c814d |
25 | our ( $initial, $final ) = ( 0, 0 ); |
e63e8323 |
26 | our $tests = YAML::LoadFile("$FindBin::Bin/optional_stress.yml"); |
7c40a30f |
27 | |
010c814d |
28 | my $total_tests = 0; |
010c814d |
29 | |
13af225c |
30 | # let the user specify a single uri to test |
31 | my $user_test = shift; |
32 | if ( $user_test ) { |
33 | plan tests => 1; |
34 | run_test( $user_test ); |
35 | } |
36 | # otherwise, run all tests |
37 | else { |
38 | map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests}; |
39 | plan tests => $total_tests; |
40 | |
41 | foreach my $test_group ( keys %{$tests} ) { |
42 | foreach my $test ( @{ $tests->{$test_group} } ) { |
43 | run_test( $test ); |
44 | } |
010c814d |
45 | } |
46 | } |
47 | |
48 | sub run_test { |
49 | my $uri = shift || die 'No URI given for test'; |
7c40a30f |
50 | |
010c814d |
51 | print "TESTING $uri\n"; |
52 | |
53 | # make a few requests to set initial memory size |
54 | for ( 1 .. 3 ) { |
55 | request( $uri ); |
56 | } |
57 | |
9b984642 |
58 | $initial = size_of($$); |
59 | print "Initial Size: $initial\n"; |
7c40a30f |
60 | |
010c814d |
61 | for ( 1 .. 500 ) { |
62 | request( $uri ); |
7c40a30f |
63 | } |
64 | |
9b984642 |
65 | $final = size_of($$); |
66 | print "Final Size: $final\n"; |
7c40a30f |
67 | |
68 | if ( $final > $initial ) { |
9b984642 |
69 | print "Leaked: " . ($final - $initial) . "\n"; |
7c40a30f |
70 | } |
71 | |
010c814d |
72 | is( $final, $initial, "'$uri' memory is not leaking" ); |
7c40a30f |
73 | } |
010c814d |
74 | |
9b984642 |
75 | sub size_of { |
76 | my $pid = shift; |
77 | |
78 | foreach my $p ( @{ $t->table } ) { |
79 | if ( $p->pid == $pid ) { |
fe796093 |
80 | return $p->rss; |
9b984642 |
81 | } |
82 | } |
83 | |
84 | die "Pid $pid not found?"; |
85 | } |
86 | |