line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CHI::t::Driver::RawMemory; |
2
|
|
|
|
|
|
|
$CHI::t::Driver::RawMemory::VERSION = '0.61'; |
3
|
1
|
|
|
1
|
|
437
|
use strict; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
85
|
|
4
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
5
|
1
|
|
|
1
|
|
398
|
use CHI::Test; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
7
|
|
6
|
1
|
|
|
1
|
|
7
|
use CHI::Test::Util qw(is_between); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
7
|
1
|
|
|
1
|
|
5
|
use base qw(CHI::t::Driver::Memory); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
482
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub new_cache { |
10
|
85
|
|
|
85
|
0
|
191
|
my $self = shift; |
11
|
|
|
|
|
|
|
|
12
|
85
|
|
|
|
|
333
|
my %params = ( $self->new_cache_options(), @_, ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# If new_cache called with datastore, ignore global flag (otherwise would be an error) |
15
|
|
|
|
|
|
|
# |
16
|
85
|
100
|
|
|
|
365
|
if ( $params{datastore} ) { |
17
|
3
|
|
|
|
|
6
|
delete $params{global}; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
85
|
|
|
|
|
535
|
my $cache = CHI->new(%params); |
21
|
85
|
|
|
|
|
590
|
return $cache; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Not applicable to raw memory |
25
|
|
|
|
|
|
|
# |
26
|
|
|
|
1
|
0
|
|
sub test_deep_copy { } |
27
|
|
|
|
1
|
0
|
|
sub test_scalar_return_values { } |
28
|
|
|
|
1
|
0
|
|
sub test_serialize { } |
29
|
|
|
|
1
|
0
|
|
sub test_serializers { } |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Would need tweaking to pass |
32
|
|
|
|
|
|
|
# |
33
|
|
|
|
1
|
0
|
|
sub test_append { } |
34
|
|
|
|
1
|
0
|
|
sub test_compress_threshold { } |
35
|
|
|
|
1
|
0
|
|
sub test_custom_discard_policy { } |
36
|
|
|
|
1
|
0
|
|
sub test_lru_discard { } |
37
|
|
|
|
1
|
0
|
|
sub test_size_awareness_with_subcaches { } |
38
|
|
|
|
1
|
0
|
|
sub test_stats { } |
39
|
|
|
|
1
|
0
|
|
sub test_subcache_overridable_params { } |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# Size of all items = 1 in this driver |
42
|
|
|
|
|
|
|
# |
43
|
|
|
|
|
|
|
sub test_size_awareness : Tests { |
44
|
1
|
|
|
1
|
0
|
709
|
my $self = shift; |
45
|
1
|
|
|
|
|
7
|
my ( $key, $value ) = $self->kvpair(); |
46
|
|
|
|
|
|
|
|
47
|
1
|
|
|
|
|
8
|
ok( !$self->new_cleared_cache()->is_size_aware(), |
48
|
|
|
|
|
|
|
"not size aware by default" ); |
49
|
1
|
|
|
|
|
518
|
ok( $self->new_cleared_cache( is_size_aware => 1 )->is_size_aware(), |
50
|
|
|
|
|
|
|
"is_size_aware turns on size awareness" ); |
51
|
1
|
|
|
|
|
502
|
ok( $self->new_cleared_cache( max_size => 10 )->is_size_aware(), |
52
|
|
|
|
|
|
|
"max_size turns on size awareness" ); |
53
|
|
|
|
|
|
|
|
54
|
1
|
|
|
|
|
516
|
my $cache = $self->new_cleared_cache( is_size_aware => 1 ); |
55
|
1
|
|
|
|
|
8
|
is( $cache->get_size(), 0, "size is 0 for empty" ); |
56
|
1
|
|
|
|
|
469
|
$cache->set( $key, $value ); |
57
|
1
|
|
|
|
|
6
|
is( $cache->get_size, 1, "size is 1 with one value" ); |
58
|
1
|
|
|
|
|
355
|
$cache->set( $key, scalar( $value x 5 ) ); |
59
|
1
|
|
|
|
|
5
|
is( $cache->get_size, 1, "size is still 1 after override" ); |
60
|
1
|
|
|
|
|
376
|
$cache->set( $key, scalar( $value x 5 ) ); |
61
|
1
|
|
|
|
|
4
|
is( $cache->get_size, 1, "size is still 1 after same overwrite" ); |
62
|
1
|
|
|
|
|
361
|
$cache->set( $key, scalar( $value x 2 ) ); |
63
|
1
|
|
|
|
|
4
|
is( $cache->get_size, 1, "size is 1 after overwrite" ); |
64
|
1
|
|
|
|
|
366
|
$cache->set( $key . "2", $value ); |
65
|
1
|
|
|
|
|
4
|
is( $cache->get_size, 2, "size is 2 after second key" ); |
66
|
1
|
|
|
|
|
376
|
$cache->remove($key); |
67
|
1
|
|
|
|
|
4
|
is( $cache->get_size, 1, "size is 1 again after removing key" ); |
68
|
1
|
|
|
|
|
369
|
$cache->remove( $key . "2" ); |
69
|
1
|
|
|
|
|
4
|
is( $cache->get_size, 0, "size is 0 again after removing keys" ); |
70
|
1
|
|
|
|
|
394
|
$cache->set( $key, $value ); |
71
|
1
|
|
|
|
|
4
|
is( $cache->get_size, 1, "size is 1 with one value" ); |
72
|
1
|
|
|
|
|
378
|
$cache->clear(); |
73
|
1
|
|
|
|
|
9
|
is( $cache->get_size, 0, "size is 0 again after clear" ); |
74
|
|
|
|
|
|
|
|
75
|
1
|
|
|
|
|
336
|
my $time = time() + 10; |
76
|
1
|
|
|
|
|
8
|
$cache->set( $key, $value, { expires_at => $time } ); |
77
|
1
|
|
|
|
|
31
|
is( $cache->get_expires_at($key), |
78
|
|
|
|
|
|
|
$time, "set options respected by size aware cache" ); |
79
|
1
|
|
|
1
|
|
9
|
} |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub test_max_size : Tests { |
82
|
1
|
|
|
1
|
0
|
732
|
my $self = shift; |
83
|
|
|
|
|
|
|
|
84
|
1
|
|
|
|
|
8
|
my $cache = $self->new_cleared_cache( max_size => 5 ); |
85
|
1
|
|
|
|
|
15
|
ok( $cache->is_size_aware, "is size aware when max_size specified" ); |
86
|
1
|
|
|
|
|
553
|
my $value = 'x'; |
87
|
|
|
|
|
|
|
|
88
|
1
|
|
|
|
|
6
|
for ( my $i = 0 ; $i < 5 ; $i++ ) { |
89
|
5
|
|
|
|
|
26
|
$cache->set( "key$i", $value ); |
90
|
|
|
|
|
|
|
} |
91
|
1
|
|
|
|
|
7
|
for ( my $i = 0 ; $i < 10 ; $i++ ) { |
92
|
10
|
|
|
|
|
2884
|
$cache->set( "key" . int( rand(10) ), $value ); |
93
|
10
|
|
|
|
|
34
|
is_between( $cache->get_size, 3, 5, |
94
|
|
|
|
|
|
|
"after iteration $i, size = " . $cache->get_size ); |
95
|
10
|
|
|
|
|
3680
|
is_between( scalar( $cache->get_keys ), |
96
|
|
|
|
|
|
|
3, 5, "after iteration $i, keys = " . scalar( $cache->get_keys ) ); |
97
|
|
|
|
|
|
|
} |
98
|
1
|
|
|
1
|
|
506
|
} |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# Test that we're caching a reference, not a deep copy |
101
|
|
|
|
|
|
|
# |
102
|
|
|
|
|
|
|
sub test_cache_ref : Tests { |
103
|
1
|
|
|
1
|
0
|
698
|
my $self = shift; |
104
|
1
|
|
|
|
|
3
|
my $cache = $self->{cache}; |
105
|
1
|
|
|
|
|
3
|
my $lst = ['foo']; |
106
|
1
|
|
|
|
|
4
|
$cache->set( 'key1' => $lst ); |
107
|
1
|
|
|
|
|
4
|
$cache->set( 'key2' => $lst ); |
108
|
1
|
|
|
|
|
4
|
is( $cache->get('key1'), $lst, "got same reference" ); |
109
|
1
|
|
|
|
|
346
|
is( $cache->get('key2'), $lst, "got same reference" ); |
110
|
1
|
|
|
|
|
338
|
$lst->[0] = 'bar'; |
111
|
1
|
|
|
|
|
5
|
is( $cache->get('key1')->[0], 'bar', "changed value in cache" ); |
112
|
1
|
|
|
1
|
|
374
|
} |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub test_short_driver_name : Tests { |
115
|
1
|
|
|
1
|
0
|
708
|
my ($self) = @_; |
116
|
|
|
|
|
|
|
|
117
|
1
|
|
|
|
|
3
|
my $cache = $self->{cache}; |
118
|
1
|
|
|
|
|
29
|
is( $cache->short_driver_name, 'RawMemory' ); |
119
|
1
|
|
|
1
|
|
326
|
} |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
1; |