File Coverage

blib/lib/CHI/t/Driver/RawMemory.pm
Criterion Covered Total %
statement 83 83 100.0
branch 2 2 100.0
condition n/a
subroutine 25 25 100.0
pod 0 16 0.0
total 110 126 87.3


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;