t/52_memory_leak.t

   1 # This was discussed here:
   2 # http://groups.google.com/group/DBM-Deep/browse_thread/thread/a6b8224ffec21bab
   3 # brought up by Alex Gallichotte
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 use Test::More;
   9
  10 plan skip_all => "Need to figure out what platforms this runs on";
  11
  12 use_ok( 'DBM::Deep' );
  13
  14 use t::common qw( new_dbm );
  15
  16 my $dbm_factory = new_dbm();
  17 while ( my $dbm_maker = $dbm_factory->() ) {
  18     my $db = $dbm_maker->();
  19
  20     my $todo  = 1000;
  21     my $allow = $todo*0.02; # NOTE: a 2% fail rate is hardly a failure
  22
  23     $db->{randkey()} = 1 for 1 .. 1000;
  24
  25     my $error_count = 0;
  26     my @mem = (mem(0), mem(1));
  27     for my $i (1 .. $todo) {
  28         $db->{randkey()} = [@mem];
  29
  30         ## DEBUG ## print STDERR " @mem     \r";
  31
  32         my @tm = (mem(0), mem(1));
  33
  34         skip( not($mem[0]), ($tm[0] <= $mem[0] or --$allow>0) );
  35         skip( not($mem[1]), ($tm[1] <= $mem[1] or --$allow>0) );
  36
  37         $error_count ++ if $tm[0] > $mem[0] or $tm[1] > $mem[1];
  38         die " ERROR: that's enough failures to prove the point ... " if $error_count > 20;
  39
  40         @mem = @tm;
  41     }
  42 }
  43
  44 sub randkey {
  45     our $i ++;
  46     my @k = map { int rand 100 } 1 .. 10;
  47     local $" = "-";
  48
  49     return "$i-@k";
  50 }
  51
  52 sub mem {
  53     open my $in, "/proc/$$/statm" or return 0;
  54     my $line = [ split m/\s+/, <$in> ];
  55     close $in;
  56
  57     return $line->[shift];
  58 }
  59
  60 __END__
  61 /proc/[number]/statm
  62
  63       Provides information about memory status in pages.  The columns are:
  64
  65           size       total program size
  66           resident   resident set size
  67           share      shared pages
  68           text       text (code)
  69           lib        library
  70           data       data/stack
  71           dt         dirty pages (unused in Linux 2.6)