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