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
|
#########################
use Test::More tests => 62;
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)" );
# Test basic store/get on key sizes
ok( $FC->set('', 'abc'), "set('', 'abc')" );
is( $FC->get(''), 'abc', "get('') eq 'abc'");
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->set(' ', 'def'), "set(' ', 'def')" );
is( $FC->get(' '), 'def', "get(' ') eq 'def'");
ok( $FC->set(' ' x 1024, 'ghi'), "set(' ' x 1024, 'ghi')");
is( $FC->get(' ' x 1024), 'ghi', "get(' ' x 1024) eq 'ghi'");
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)");
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->set('def', 'x'), "set('def', 'x')");
is( $FC->get('def'), 'x', "get('def') eq 'x'");
ok( $FC->set('ghi', 'x' . ('y' x 1024) . 'z'), "set('ghi', ...)");
is( $FC->get('ghi'), 'x' . ('y' x 1024) . 'z', "get('ghi') eq ...");
# 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')" );
# 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\")" );
# Check UTF8
ok( $FC->set("key\x{263A}", "val"), "set utf8 key" );
is( $FC->get("key\x{263A}"), "val", "get utf8 key" );
ok( $FC->set("key", "val\x{263A}"), "set utf8 val" );
is( $FC->get("key"), "val\x{263A}", "get 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( !defined $FC->get('def'), "post clear 2" );
ok( !defined $FC->get('ghi'), "post clear 3" );
ok( !defined $FC->get('jkl'), "post clear 4" );
ok( !defined $FC->get("key"), "post clear 5" );
ok( !defined $FC->get("key\x{263A}"), "post clear 6" );
ok( !defined $FC->get("key2\x{263A}"), "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");
|
