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