1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
# tests for functions documented in memcached_set.pod
use strict;
use warnings;
use Test::More;
use Memcached::libmemcached
# functions explicitly tested by this file
qw(
),
# other functions used by the tests
qw(
memcached_set
memcached_get
memcached_mget
memcached_mget_into_hashref
);
use lib 't/lib';
use libmemcached_test;
my $memc = libmemcached_test_create();
my $items = 2;
plan tests => 21;
my ($rv, $rc, $flags);
my $t1= time();
my $flag_orig = 0xF000F00F;
my %data = map { ("k$_.$t1" => "val$_.$t1") } (1..$items);
my ($set_cb_expected_defsv, @set_cb_expected_args);
my $set_cb_called = 0;
my $set_cb = sub {
++$set_cb_called;
print "set_cb(@_)\n";
is $_, $set_cb_expected_defsv, '$_ should be the value';
is scalar @_, 2, '@_ should be two elems: $key and $flags';
is $_[0], $set_cb_expected_args[0], 'arg 0 should be the key';
is $_[1], $set_cb_expected_args[1], 'arg 1 should be the flags';
return;
};
$memc->set_callback_coderefs($set_cb, undef);
print "test read-only access to values from callback\n";
for my $k (keys %data) {
$set_cb_expected_defsv = $data{$k};
@set_cb_expected_args = ( $k, $flag_orig );
ok memcached_set($memc, $k, $data{$k}, 0, $flag_orig);
}
for my $k (keys %data) {
$set_cb_expected_defsv = $data{$k};
@set_cb_expected_args = ( $k, $flag_orig );
is memcached_get($memc, $k), $data{$k};
}
is $set_cb_called, scalar keys %data;
$set_cb_called = 0;
$memc->set_callback_coderefs(undef, sub { ++$set_cb_called; return });
my %got;
ok memcached_mget_into_hashref($memc, [ keys %data ], \%got);
is_deeply \%got, \%data;
print "test modification of values by callback\n";
my $expected_flags = 0xE0E0E0E0;
$set_cb = sub {
$_ = uc($_).lc($_);
$_[1] = $expected_flags;
return;
};
$memc->set_callback_coderefs(undef, $set_cb);
for my $k (keys %data) {
my $v = $data{$k};
ok memcached_set($memc, $k, $v);
is memcached_get($memc, $k, my $flags), uc($v).lc($v);
is $flags, $expected_flags, "flags is $flags (expected $expected_flags)" ;
}
|
