File Coverage

blib/lib/CHI/t/Driver/RawMemory.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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