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; |
09dd8113 |
7 | use warnings FATAL => 'all'; |
8 | |
9 | use Test::More; |
b391d9ac |
10 | use DBM::Deep; |
09dd8113 |
11 | |
12 | plan skip_all => "Need to figure out what platforms this runs on"; |
13 | |
b391d9ac |
14 | use t::common qw( new_fh ); |
15 | |
16 | my ($fh, $filename) = new_fh(); |
17 | my $db = DBM::Deep->new( file => $filename, fh => $fh, ); |
18 | |
97d40a0a |
19 | my $todo = 1000; |
20 | my $allow = $todo*0.02; # NOTE: a 2% fail rate is hardly a failure |
b391d9ac |
21 | |
22 | $db->{randkey()} = 1 for 1 .. 1000; |
23 | |
24 | plan tests => $todo*2; |
25 | |
26 | my $error_count = 0; |
27 | my @mem = (mem(0), mem(1)); |
28 | for my $i (1 .. $todo) { |
29 | $db->{randkey()} = [@mem]; |
30 | |
97d40a0a |
31 | ## DEBUG ## print STDERR " @mem \r"; |
b391d9ac |
32 | |
33 | my @tm = (mem(0), mem(1)); |
34 | |
97d40a0a |
35 | skip( not($mem[0]), ($tm[0] <= $mem[0] or --$allow>0) ); |
36 | skip( not($mem[1]), ($tm[1] <= $mem[1] or --$allow>0) ); |
b391d9ac |
37 | |
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; |
40 | |
41 | @mem = @tm; |
42 | } |
43 | |
44 | sub randkey { |
45 | our $i ++; |
46 | my @k = map { int rand 100 } 1 .. 10; |
47 | local $" = "-"; |
48 | |
49 | return "$i-@k"; |
50 | } |
51 | |
52 | sub mem { |
53 | open my $in, "/proc/$$/statm" or return 0; |
54 | my $line = [ split m/\s+/, <$in> ]; |
55 | close $in; |
56 | |
57 | return $line->[shift]; |
58 | } |
59 | |
60 | __END__ |
61 | /proc/[number]/statm |
62 | |
63 | Provides information about memory status in pages. The columns are: |
64 | |
65 | size total program size |
66 | resident resident set size |
67 | share shared pages |
68 | text text (code) |
69 | lib library |
70 | data data/stack |
71 | dt dirty pages (unused in Linux 2.6) |