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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
#########################
use Test::More tests => 85;
BEGIN { use_ok('Cache::FastMmap') };
use strict;
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
my $FC = Cache::FastMmap->new(init_file => 1, serializer => '');
ok( defined $FC );
# Test empty cache
ok( !defined $FC->get(''), "empty get('')" );
ok( !defined $FC->get(' '), "empty get(' ')" );
ok( !defined $FC->get(' ' x 1024), "empty get(' ' x 1024)" );
ok( !defined $FC->get(' ' x 65536), "empty get(' ' x 65536)" );
ok( !$FC->exists(''), "false exists('')" );
ok( !$FC->exists(' '), "false exists(' ')" );
ok( !$FC->exists(' ' x 1024), "false exists(' ' x 1024)" );
ok( !$FC->exists(' ' x 65536), "false exists(' ' x 65536)" );
# Test basic store/get on key sizes
ok( $FC->set('', 'abc'), "set('', 'abc')" );
is( $FC->get(''), 'abc', "get('') eq 'abc'");
ok( $FC->exists(''), "true exists('')");
my ($R, $DidStore) = $FC->get_and_set('', sub { 'abcd' });
is ($R, "abcd", "get_and_set('', sub { 'abcd' })" );
is ($DidStore, 1, "get_and_set did store");
ok( $FC->exists(''), "true exists('')");
ok( $FC->set(' ', 'def'), "set(' ', 'def')" );
is( $FC->get(' '), 'def', "get(' ') eq 'def'");
ok( $FC->exists(' '), "true exists(' ')");
ok( $FC->set(' ' x 1024, 'ghi'), "set(' ' x 1024, 'ghi')");
is( $FC->get(' ' x 1024), 'ghi', "get(' ' x 1024) eq 'ghi'");
ok( $FC->exists(' ' x 1024), "true exists(' ' x 1024)");
my ($R, $DidStore) = $FC->get_and_set(' ' x 1024, sub { 'bcde' });
is($R, "bcde", "get_and_set(' ' x 1024, sub { 'bcde' })" );
is($DidStore, 1, "get_and_set did store");
# Bigger than the page size - should not work
ok( !$FC->set(' ' x 65536, 'jkl'), "set(' ' x 65536, 'jkl')");
ok( !defined $FC->get(' ' x 65536), "empty get(' ' x 65536)");
ok( !$FC->exists(' ' x 65536), "false exists(' ' x 65536)");
my ($R, $DidStore) = $FC->get_and_set(' ' x 65536, sub { 'cdef' });
ok( !defined $FC->get(' ' x 65536), "empty get(' ' x 65536)" );
is($DidStore, 0, "get_and_set did not store");
# Test basic store/get on value sizes
ok( $FC->set('abc', ''), "set('abc', '')");
is( $FC->get('abc'), '', "get('abc') eq ''");
ok( $FC->exists('abc'), "true exists('abc')");
ok( $FC->set('def', 'x'), "set('def', 'x')");
is( $FC->get('def'), 'x', "get('def') eq 'x'");
ok( $FC->exists('def'), "true exists('def')");
ok( $FC->set('ghi', 'x' . ('y' x 1024) . 'z'), "set('ghi', ...)");
is( $FC->get('ghi'), 'x' . ('y' x 1024) . 'z', "get('ghi') eq ...");
ok( $FC->exists('ghi'), "true exists('ghi')");
# Bigger than the page size - should not work
ok( !$FC->set('jkl', 'x' . ('y' x 65536) . 'z'), "set('jkl', ...)");
ok( !defined $FC->get('jkl'), "empty get('jkl')" );
ok( !$FC->exists('jkl'), "false exists('jkl')");
# Ref key should use 'stringy' version
my $Ref = [ ];
ok( $FC->set($Ref, 'abcd'), "set($Ref)" );
is( $FC->get($Ref), 'abcd', "get($Ref)" );
is( $FC->get("$Ref"), 'abcd', "get(\"$Ref\")" );
ok( $FC->exists("$Ref"), "true exists(\"$Ref\")");
# Check UTF8
ok( $FC->set("key\x{263A}", "val"), "set utf8 key" );
is( $FC->get("key\x{263A}"), "val", "get utf8 key" );
ok( $FC->exists("key\x{263A}"), "true exists utf8 key");
ok( $FC->set("key", "val\x{263A}"), "set utf8 val" );
is( $FC->get("key"), "val\x{263A}", "get utf8 val" );
ok( $FC->exists("key"), "true exists utf8 val");
ok( $FC->set("key2\x{263A}", "val2\x{263A}"), "set utf8 key/val" );
is( $FC->get("key2\x{263A}"), "val2\x{263A}", "get utf8 key/val" );
# Check clearing actually works
$FC->clear();
ok( !defined $FC->get('abc'), "post clear 1" );
ok( !$FC->exists('abc'), "false exists post clear 1" );
ok( !defined $FC->get('def'), "post clear 2" );
ok( !$FC->exists('def'), "false exists post clear 2" );
ok( !defined $FC->get('ghi'), "post clear 3" );
ok( !$FC->exists('ghi'), "false exists post clear 3" );
ok( !defined $FC->get('jkl'), "post clear 4" );
ok( !$FC->exists('jkl'), "false exists post clear 4" );
ok( !defined $FC->get("key"), "post clear 5" );
ok( !$FC->exists('key'), "false exists post clear 5" );
ok( !defined $FC->get("key\x{263A}"), "post clear 6" );
ok( !$FC->exists("key"), "false exists post clear 6");
ok( !defined $FC->get("key2\x{263A}"), "post clear 7" );
ok( !$FC->exists("key2\x{263A}"), "false exists post clear 7");
# Check getting key/value lists
ok( $FC->set("abc", "123"), "get_keys set 1" );
ok( $FC->set("bcd", "234"), "get_keys set 2" );
ok( $FC->set("cde", "345"), "get_keys set 3" );
is( join(",", sort $FC->get_keys), "abc,bcd,cde", "get_keys 1");
my %keys = map { $_->{key} => $_ } $FC->get_keys(2);
is( scalar(keys %keys), 3, "get_keys 2" );
is($keys{abc}->{value}, "123", "get_keys 3");
is($keys{bcd}->{value}, "234", "get_keys 4");
is($keys{cde}->{value}, "345", "get_keys 5");
# Test getting key/value lists with UTF8
$FC->set("def\x{263A}", "456\x{263A}");
is( join(",", sort $FC->get_keys), "abc,bcd,cde,def\x{263A}", "get_keys 6");
%keys = map { $_->{key} => $_ } $FC->get_keys(2);
is( scalar(keys %keys), 4 , "get_keys 7");
is($keys{abc}->{value}, "123", "get_keys 8");
is($keys{bcd}->{value}, "234", "get_keys 9");
is($keys{cde}->{value}, "345", "get_keys 10");
is($keys{"def\x{263A}"}->{value}, "456\x{263A}", "get_keys 11");
# basic multi_* tests
$FC->multi_set("page1", { k1 => 1, k2 => 2 });
$FC->multi_set("page2", { k3 => 1, k4 => 2 });
my $R = $FC->multi_get("page1", [ qw(k1 k2) ]);
is($R->{k1}, 1, "multi_get 1");
is($R->{k2}, 2, "multi_get 2");
$R = $FC->multi_get("page2", [ qw(k3 k4) ]);
is($R->{k3}, 1, "multi_get 3");
is($R->{k4}, 2, "multi_get 4");
|
