t/t9503/test_cache_interface.pl

   1 #!/usr/bin/perl
   2 use lib (split(/:/, $ENV{GITPERLLIB}));
   3
   4 use warnings;
   5 use strict;
   6
   7 use Test::More;
   8
   9 # test source version
  10 use lib $ENV{GITWEBLIBDIR} || "$ENV{GIT_BUILD_DIR}/gitweb/lib";
  11
  12
  13 # Test creating a cache
  14 #
  15 BEGIN { use_ok('GitwebCache::SimpleFileCache'); }
  16 diag("Using lib '$INC[0]'");
  17 diag("Testing '$INC{'GitwebCache/SimpleFileCache.pm'}'");
  18
  19 my $cache = new_ok('GitwebCache::SimpleFileCache');
  20
  21 # Test that default values are defined
  22 #
  23 ok(defined $GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT,
  24         '$DEFAULT_CACHE_ROOT defined');
  25 ok(defined $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH,
  26         '$DEFAULT_CACHE_DEPTH defined');
  27
  28 # Test accessors and default values for cache
  29 #
  30 SKIP: {
  31         skip 'default values not defined', 3
  32                 unless ($GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT &&
  33                         $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH);
  34
  35         is($cache->get_namespace(), '', "default namespace is ''");
  36         cmp_ok($cache->get_root(),  'eq', $GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT,
  37                 "default cache root is '$GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT'");
  38         cmp_ok($cache->get_depth(), '==', $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH,
  39                 "default cache depth is $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH");
  40 }
  41
  42 # Test the getting, setting, and removal of a cached value
  43 # (Cache::Cache interface)
  44 #
  45 my $key = 'Test Key';
  46 my $value = 'Test Value';
  47
  48 subtest 'Cache::Cache interface' => sub {
  49         foreach my $method (qw(get set remove)) {
  50                 can_ok($cache, $method);
  51         }
  52
  53         $cache->set($key, $value);
  54         cmp_ok($cache->get_size($key), '>', 0, 'get_size after set, is greater than 0');
  55         is($cache->get($key), $value,          'get after set, returns cached value');
  56         $cache->remove($key);
  57         ok(!defined($cache->get($key)),        'get after remove, is undefined');
  58
  59         eval { $cache->remove('Not-Existent Key'); };
  60         ok(!$@,                                'remove on non-existent key doesn\'t die');
  61         diag($@) if $@;
  62
  63         done_testing();
  64 };
  65
  66 # Test the getting and setting of a cached value
  67 # (CHI interface)
  68 #
  69 my $call_count = 0;
  70 sub get_value {
  71         $call_count++;
  72         return $value;
  73 }
  74 subtest 'CHI interface' => sub {
  75         can_ok($cache, qw(compute));
  76
  77         is($cache->compute($key, \&get_value), $value, "compute 1st time (set) returns '$value'");
  78         is($cache->compute($key, \&get_value), $value, "compute 2nd time (get) returns '$value'");
  79         is($cache->compute($key, \&get_value), $value, "compute 3rd time (get) returns '$value'");
  80         cmp_ok($call_count, '==', 1, 'get_value() is called once from compute');
  81
  82         done_testing();
  83 };
  84
  85 # Test cache expiration
  86 #
  87 subtest 'cache expiration' => sub {
  88         $cache->set_expires_in(60*60*24); # set expire time to 1 day
  89         cmp_ok($cache->get_expires_in(), '>', 0, '"expires in" is greater than 0');
  90         is($cache->get($key), $value,            'get returns cached value (not expired in 1d)');
  91
  92         $cache->set_expires_in(-1); # set expire time to never expire
  93         is($cache->get_expires_in(), -1,         '"expires in" is set to never (-1)');
  94         is($cache->get($key), $value,            'get returns cached value (not expired)');
  95
  96         $cache->set_expires_in(0);
  97         is($cache->get_expires_in(),  0,         '"expires in" is set to now (0)');
  98         $cache->set($key, $value);
  99         ok(!defined($cache->get($key)),          'cache is expired');
 100
 101         done_testing();
 102 };
 103
 104 # Test assertions for adaptive cache expiration
 105 #
 106 my $load = 0.0;
 107 sub load { return $load; }
 108 my $expires_min = 10;
 109 my $expires_max = 30;
 110 $cache->set_expires_in(-1);
 111 $cache->set_expires_min($expires_min);
 112 $cache->set_expires_max($expires_max);
 113 $cache->set_check_load(\&load);
 114 subtest 'adaptive cache expiration' => sub {
 115         cmp_ok($cache->get_expires_min(), '==', $expires_min,
 116                '"expires min" set correctly');
 117         cmp_ok($cache->get_expires_max(), '==', $expires_max,
 118                '"expires max" set correctly');
 119
 120         $load = 0.0;
 121         cmp_ok($cache->get_expires_in(), '>=', $expires_min,
 122                '"expires in" bound from down for load=0');
 123         cmp_ok($cache->get_expires_in(), '<=', $expires_max,
 124                '"expires in" bound from up   for load=0');
 125
 126         $load = 1_000;
 127         cmp_ok($cache->get_expires_in(), '>=', $expires_min,
 128                '"expires in" bound from down for heavy load');
 129         cmp_ok($cache->get_expires_in(), '<=', $expires_max,
 130                '"expires in" bound from up   for heavy load');
 131
 132         done_testing();
 133 };
 134
 135 $cache->set_expires_in(-1);
 136
 137 done_testing();