/usr/share/perl5/CHI/t/Driver/Memory.pm is in libchi-perl 0.60-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | package CHI::t::Driver::Memory;
$CHI::t::Driver::Memory::VERSION = '0.60';
use strict;
use warnings;
use CHI::Test;
use CHI::Test::Driver::Role::CheckKeyValidity;
use Test::Warn;
use base qw(CHI::t::Driver);
# Skip multiple process test
sub test_multiple_processes { }
sub new_cache_options {
my $self = shift;
return ( $self->SUPER::new_cache_options(), global => 1 );
}
sub new_cache {
my $self = shift;
my %params = ( $self->new_cache_options(), @_ );
# If new_cache called with datastore, ignore global flag (otherwise would be an error)
#
if ( $params{datastore} ) {
delete $params{global};
}
# Check test key validity on every get and set - only necessary to do for one driver
#
$params{roles} = ['+CHI::Test::Driver::Role::CheckKeyValidity'];
$params{test_object} = $self;
my $cache = CHI->new(%params);
return $cache;
}
sub test_short_driver_name : Tests {
my ($self) = @_;
my $cache = $self->{cache};
is( $cache->short_driver_name, 'Memory' );
}
# Warn if global or datastore not passed, but still use global datastore by default
#
sub test_global_or_datastore_required : Tests {
my ( $cache, $cache2 );
warning_like( sub { $cache = CHI->new( driver => 'Memory' ) },
qr/must specify either/ );
warning_like( sub { $cache2 = CHI->new( driver => 'Memory' ) },
qr/must specify either/ );
$cache->set( 'foo', 5 );
is( $cache2->get('foo'), 5, "defaulted to global datastore" );
}
# Make sure two caches don't share datastore
#
sub test_different_datastores : Tests {
my $self = shift;
my $cache1 = CHI->new( driver => 'Memory', datastore => {} );
my $cache2 = CHI->new( driver => 'Memory', datastore => {} );
$self->set_some_keys($cache1);
ok( !$cache2->get_keys() );
}
# Make sure two global=0 caches don't share datastore
#
sub test_different_global_0 : Tests {
my $self = shift;
my $cache1 = CHI->new( driver => 'Memory', global => 0 );
my $cache2 = CHI->new( driver => 'Memory', global => 0 );
$self->set_some_keys($cache1);
ok( !$cache2->get_keys() );
}
# Make sure cache is cleared when datastore itself is cleared
#
sub test_clear_datastore : Tests {
my $self = shift;
$self->num_tests( $self->{key_count} * 3 + 6 );
my (@caches);
my %datastore;
$caches[0] =
$self->new_cache( namespace => 'name', datastore => \%datastore );
$caches[1] =
$self->new_cache( namespace => 'other', datastore => \%datastore );
$caches[2] =
$self->new_cache( namespace => 'name', datastore => \%datastore );
$self->set_some_keys( $caches[0] );
$self->set_some_keys( $caches[1] );
%datastore = ();
foreach my $i ( 0 .. 2 ) {
$self->_verify_cache_is_cleared( $caches[$i],
"cache $i after out of scope" );
}
}
sub test_lru_discard : Tests {
my $self = shift;
return 'author testing only' unless ( $ENV{AUTHOR_TESTING} );
my $cache = $self->new_cleared_cache( max_size => 41 );
is( $cache->discard_policy, 'lru' );
my $value_20 = 'x' x 6;
foreach my $key ( map { "key$_" } (qw(1 2 3 4 5 6 5 6 5 3 2)) ) {
$cache->set( $key, $value_20 );
}
cmp_set( [ $cache->get_keys ], [ "key2", "key3" ] );
}
1;
|