Allow user-specified uri to test for leaks
[catagits/Catalyst-Runtime.git] / t / optional / memleak.t
CommitLineData
7c40a30f 1#!perl
2
3use strict;
4use warnings;
5
6use FindBin;
7use lib "$FindBin::Bin/../live/lib";
8
9use Test::More;
10use Catalyst::Test 'TestApp';
010c814d 11use YAML;
11956eee 12eval "use GTop";
7c40a30f 13
14plan skip_all => 'set TEST_MEMLEAK to enable this test'
15 unless $ENV{TEST_MEMLEAK};
16plan skip_all => 'GTop required for this test' if $@;
17
010c814d 18our $gtop = GTop->new;
19our ( $initial, $final ) = ( 0, 0 );
20our $tests = YAML::LoadFile("$FindBin::Bin/stress.yml");
7c40a30f 21
010c814d 22my $total_tests = 0;
010c814d 23
13af225c 24# let the user specify a single uri to test
25my $user_test = shift;
26if ( $user_test ) {
27 plan tests => 1;
28 run_test( $user_test );
29}
30# otherwise, run all tests
31else {
32 map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests};
33 plan tests => $total_tests;
34
35 foreach my $test_group ( keys %{$tests} ) {
36 foreach my $test ( @{ $tests->{$test_group} } ) {
37 run_test( $test );
38 }
010c814d 39 }
40}
41
42sub run_test {
43 my $uri = shift || die 'No URI given for test';
7c40a30f 44
010c814d 45 print "TESTING $uri\n";
46
47 # make a few requests to set initial memory size
48 for ( 1 .. 3 ) {
49 request( $uri );
50 }
51
52 $initial = $gtop->proc_mem($$)->size;
c6294ccd 53 print "Initial Size: " . GTop::size_string($initial) . "\n";
7c40a30f 54
010c814d 55 for ( 1 .. 500 ) {
56 request( $uri );
7c40a30f 57 }
58
010c814d 59 $final = $gtop->proc_mem($$)->size;
c6294ccd 60 print "Final Size: " . GTop::size_string($final) . "\n";
7c40a30f 61
62 if ( $final > $initial ) {
c6294ccd 63 print "Leaked Bytes: " . GTop::size_string($final - $initial) . "\n";
7c40a30f 64 }
65
010c814d 66 is( $final, $initial, "'$uri' memory is not leaking" );
7c40a30f 67}
010c814d 68