2 # This was discussed here:
3 # http://groups.google.com/group/DBM-Deep/browse_thread/thread/a6b8224ffec21bab
4 # brought up by Alex Gallichotte
7 use warnings FATAL => 'all';
12 plan skip_all => "Need to figure out what platforms this runs on";
14 use t::common qw( new_fh );
16 my ($fh, $filename) = new_fh();
17 my $db = DBM::Deep->new( file => $filename, fh => $fh, );
20 my $allow = $todo*0.02; # NOTE: a 2% fail rate is hardly a failure
22 $db->{randkey()} = 1 for 1 .. 1000;
24 plan tests => $todo*2;
27 my @mem = (mem(0), mem(1));
28 for my $i (1 .. $todo) {
29 $db->{randkey()} = [@mem];
31 ## DEBUG ## print STDERR " @mem \r";
33 my @tm = (mem(0), mem(1));
35 skip( not($mem[0]), ($tm[0] <= $mem[0] or --$allow>0) );
36 skip( not($mem[1]), ($tm[1] <= $mem[1] or --$allow>0) );
38 $error_count ++ if $tm[0] > $mem[0] or $tm[1] > $mem[1];
39 die " ERROR: that's enough failures to prove the point ... " if $error_count > 20;
46 my @k = map { int rand 100 } 1 .. 10;
53 open my $in, "/proc/$$/statm" or return 0;
54 my $line = [ split m/\s+/, <$in> ];
57 return $line->[shift];
63 Provides information about memory status in pages. The columns are:
65 size total program size
66 resident resident set size
71 dt dirty pages (unused in Linux 2.6)