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 | |
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) |