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