View | Details | Raw Unified | Return to bug 13193
Collapse All | Expand All

(-)a/t/01-memcached.t (-1 / +104 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use strict;
4
use warnings;
5
6
use Test::More tests => 1;
7
use Cache::Memcached::Fast;
8
use IO::Select;
9
10
my $cache = Cache::Memcached::Fast->new({
11
    servers => ["localhost:11211"],
12
});
13
my $map = {
14
    akey => '100',
15
    bkey => 'hundred',
16
    ckey => 'cent',
17
};
18
#Add keys for test
19
foreach my $key ( keys %$map ){
20
    $cache->add($key,$map->{$key});
21
}
22
23
my @children = ();
24
my $select = IO::Select->new();
25
for ( 1..10 ){
26
    my ($read_child,$write_parent);
27
    pipe($read_child,$write_parent);
28
    my $pid = fork;
29
    if ($pid == 0){
30
        close($read_child);
31
        my $a_problems = check_cache({
32
            key => "akey",
33
            iterations => int(rand(50)),
34
        });
35
        my $b_problems = check_cache({
36
            key => "bkey",
37
            iterations => int(rand(50)),
38
        });
39
        my $c_problems = check_cache({
40
            key => "ckey",
41
            iterations => int(rand(50)),
42
        });
43
        my $total_problems = $a_problems + $b_problems + $c_problems;
44
45
        print $write_parent "$total_problems\n";
46
        close($write_parent);
47
        exit;
48
    }
49
    else {
50
        close($write_parent);
51
        $select->add($read_child);
52
        push(@children,$pid);
53
    }
54
}
55
56
my $problems = 0;
57
while ( my @ready = $select->can_read(.25) ){
58
    foreach my $fh (@ready){
59
        my $msg = <$fh>;
60
        if ($msg){
61
            chomp($msg);
62
            $problems += $msg;
63
            $select->remove($fh);
64
            $fh->close;
65
        }
66
    }
67
}
68
69
foreach my $child (@children){
70
    waitpid($child,0);
71
}
72
#Delete keys that were added
73
foreach my $key ( keys %$map ){
74
    $cache->delete($key);
75
}
76
warn "Finished $problems\n";
77
is($problems,0,"There should be no problems reported.");
78
79
sub check_cache {
80
    my ($args) = @_;
81
    my $problems = 0;
82
    my $key = $args->{key};
83
    my $iterations = $args->{iterations};
84
    if ($key && defined $iterations){
85
        $iterations++;
86
        #warn "$$) Fetching $key $iterations times\n";
87
        for ( 1 .. $iterations ){
88
            my $cached_value = $cache->get($key);
89
            my $problem = "";
90
            if ( ! defined $cached_value ){
91
                $cached_value = 'NULL';
92
                $problem = 1;
93
            }
94
            elsif ($cached_value ne $map->{$key}){
95
                $problem = 1;
96
            }
97
            if ($problem){
98
                $problems++;
99
                warn "Process:$$\t Key: $key\t Correct value: $map->{$key}\t Cached value: $cached_value\n";
100
            }
101
        }
102
    }
103
    return $problems;
104
}

Return to bug 13193