File Coverage

blib/lib/CHI/t/Driver/RawMemory.pm
Criterion Covered Total %
statement 94 94 100.0
branch 2 2 100.0
condition n/a
subroutine 25 25 100.0
pod 0 16 0.0
total 121 137 88.3


line stmt bran cond sub pod time code
1             package CHI::t::Driver::RawMemory;
2             $CHI::t::Driver::RawMemory::VERSION = '0.60';
3 1     1   441 use strict;
  1         1  
  1         38  
4 1     1   4 use warnings;
  1         1  
  1         22  
5 1     1   294 use CHI::Test;
  1         2  
  1         6  
6 1     1   5 use CHI::Test::Util qw(is_between);
  1         1  
  1         49  
7 1     1   4 use base qw(CHI::t::Driver::Memory);
  1         2  
  1         493  
8              
9             sub new_cache {
10 85     85 0 139 my $self = shift;
11              
12 85         495 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       300 if ( $params{datastore} ) {
17 3         7 delete $params{global};
18             }
19              
20 85         469 my $cache = CHI->new(%params);
21 85         404 return $cache;
22             }
23              
24             # Not applicable to raw memory
25             #
26 1     1 0 200 sub test_deep_copy { }
27 1     1 0 267 sub test_scalar_return_values { }
28 1     1 0 281 sub test_serialize { }
29 1     1 0 264 sub test_serializers { }
30              
31             # Would need tweaking to pass
32             #
33 1     1 0 193 sub test_append { }
34 1     1 0 165 sub test_compress_threshold { }
35 1     1 0 175 sub test_custom_discard_policy { }
36 1     1 0 175 sub test_lru_discard { }
37 1     1 0 282 sub test_size_awareness_with_subcaches { }
38 1     1 0 262 sub test_stats { }
39 1     1 0 270 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 152 my $self = shift;
45 1         8 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         320 ok( $self->new_cleared_cache( is_size_aware => 1 )->is_size_aware(),
50             "is_size_aware turns on size awareness" );
51 1         300 ok( $self->new_cleared_cache( max_size => 10 )->is_size_aware(),
52             "max_size turns on size awareness" );
53              
54 1         278 my $cache = $self->new_cleared_cache( is_size_aware => 1 );
55 1         12 is( $cache->get_size(), 0, "size is 0 for empty" );
56 1         248 $cache->set( $key, $value );
57 1         4 is( $cache->get_size, 1, "size is 1 with one value" );
58 1         207 $cache->set( $key, scalar( $value x 5 ) );
59 1         3 is( $cache->get_size, 1, "size is still 1 after override" );
60 1         210 $cache->set( $key, scalar( $value x 5 ) );
61 1         5 is( $cache->get_size, 1, "size is still 1 after same overwrite" );
62 1         350 $cache->set( $key, scalar( $value x 2 ) );
63 1         5 is( $cache->get_size, 1, "size is 1 after overwrite" );
64 1         316 $cache->set( $key . "2", $value );
65 1         5 is( $cache->get_size, 2, "size is 2 after second key" );
66 1         353 $cache->remove($key);
67 1         5 is( $cache->get_size, 1, "size is 1 again after removing key" );
68 1         349 $cache->remove( $key . "2" );
69 1         5 is( $cache->get_size, 0, "size is 0 again after removing keys" );
70 1         299 $cache->set( $key, $value );
71 1         5 is( $cache->get_size, 1, "size is 1 with one value" );
72 1         325 $cache->clear();
73 1         12 is( $cache->get_size, 0, "size is 0 again after clear" );
74              
75 1         311 my $time = time() + 10;
76 1         9 $cache->set( $key, $value, { expires_at => $time } );
77 1         32 is( $cache->get_expires_at($key),
78             $time, "set options respected by size aware cache" );
79 1     1   5 }
  1         2  
  1         4  
80              
81             sub test_max_size : Tests {
82 1     1 0 163 my $self = shift;
83              
84 1         9 my $cache = $self->new_cleared_cache( max_size => 5 );
85 1         16 ok( $cache->is_size_aware, "is size aware when max_size specified" );
86 1         394 my $value = 'x';
87              
88 1         10 for ( my $i = 0 ; $i < 5 ; $i++ ) {
89 5         37 $cache->set( "key$i", $value );
90             }
91 1         6 for ( my $i = 0 ; $i < 10 ; $i++ ) {
92 10         2974 $cache->set( "key" . int( rand(10) ), $value );
93 10         41 is_between( $cache->get_size, 3, 5,
94             "after iteration $i, size = " . $cache->get_size );
95 10         4116 is_between( scalar( $cache->get_keys ),
96             3, 5, "after iteration $i, keys = " . scalar( $cache->get_keys ) );
97             }
98 1     1   356 }
  1         2  
  1         3  
99              
100             # Test that we're caching a reference, not a deep copy
101             #
102             sub test_cache_ref : Tests {
103 1     1 0 146 my $self = shift;
104 1         3 my $cache = $self->{cache};
105 1         2 my $lst = ['foo'];
106 1         8 $cache->set( 'key1' => $lst );
107 1         2 $cache->set( 'key2' => $lst );
108 1         10 is( $cache->get('key1'), $lst, "got same reference" );
109 1         237 is( $cache->get('key2'), $lst, "got same reference" );
110 1         223 $lst->[0] = 'bar';
111 1         5 is( $cache->get('key1')->[0], 'bar', "changed value in cache" );
112 1     1   278 }
  1         2  
  1         5  
113              
114             sub test_short_driver_name : Tests {
115 1     1 0 230 my ($self) = @_;
116              
117 1         3 my $cache = $self->{cache};
118 1         46 is( $cache->short_driver_name, 'RawMemory' );
119 1     1   272 }
  1         3  
  1         6  
120              
121             1;