t/52_memory_leak.t

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