t/52_memory_leak.t

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