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 use Data::Dumper;
   9
  10 # test source version; there is no installation target for gitweb
  11 my $cache_pm = "$ENV{TEST_DIRECTORY}/../gitweb/cache.pm";
  12
  13 unless (-f "$cache_pm") {
  14         plan skip_all => "$cache_pm not found";
  15 }
  16
  17 # it is currently not a proper Perl module, so we use 'do FILE'
  18 # instead of: BEGIN { use_ok('GitwebCache::SimpleFileCache') }
  19 my $return = do "$cache_pm";
  20 ok(!$@,              "parse gitweb/cache.pm")
  21         or diag("parse error:\n", $@);
  22 ok(defined $return,  "do    gitweb/cache.pm");
  23 ok($return,          "run   gitweb/cache.pm");
  24
  25
  26 # Test creating a cache
  27 #
  28 my $cache = new_ok('GitwebCache::SimpleFileCache',
  29         [ { 'cache_root' => 'cache', 'cache_depth' => 2 } ]);
  30
  31 # Test that default values are defined
  32 #
  33 ok(defined $GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT,
  34         '$DEFAULT_CACHE_ROOT defined');
  35 ok(defined $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH,
  36         '$DEFAULT_CACHE_DEPTH defined');
  37
  38 # Test accessors and default values for cache
  39 #
  40 SKIP: {
  41         skip 'default values not defined', 3
  42                 unless ($GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT &&
  43                         $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH);
  44
  45         is($cache->get_namespace(), '', "default namespace is ''");
  46         is($cache->get_root(), $GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT,
  47                 "default cache root is '$GitwebCache::SimpleFileCache::DEFAULT_CACHE_ROOT'");
  48         cmp_ok($cache->get_depth(), '==', $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH,
  49                 "default cache depth is $GitwebCache::SimpleFileCache::DEFAULT_CACHE_DEPTH");
  50 }
  51
  52 # Test the getting, setting, and removal of a cached value
  53 # (Cache::Cache interface)
  54 #
  55 my $key = 'Test Key';
  56 my $value = 'Test Value';
  57 can_ok($cache, qw(get set remove));
  58 #ok(!defined($cache->get($key)),        'get before set')
  59 #       or diag("get returned '", $cache->get($key), "' for $key");
  60 $cache->set($key, $value);
  61 is($cache->get($key), $value,          'get after set, returns cached value');
  62 cmp_ok($cache->get_size($key), '>', 0, 'get_size after set, is greater than 0');
  63 $cache->remove($key);
  64 ok(!defined($cache->get($key)),        'get after remove, is undefined');
  65 eval { $cache->remove('Not-Existent Key'); };
  66 ok(!$@,                                'remove on non-existent key doesn\'t die');
  67
  68 # Test the getting and setting of a cached value
  69 # (CHI interface)
  70 #
  71 my $call_count = 0;
  72 sub get_value {
  73         $call_count++;
  74         return $value;
  75 }
  76 can_ok($cache, qw(compute));
  77 is($cache->compute($key, \&get_value), $value, 'compute 1st time (set)');
  78 is($cache->compute($key, \&get_value), $value, 'compute 2nd time (get)');
  79 is($cache->compute($key, \&get_value), $value, 'compute 3rd time (get)');
  80 cmp_ok($call_count, '==', 1, 'get_value() is called once from compute');
  81
  82 # Test cache expiration for 'expire now'
  83 #
  84 $cache->set_expires_in(60*60*24); # set expire time to 1 day
  85 cmp_ok($cache->get_expires_in(), '>', 0, '"expires in" is greater than 0');
  86 is($cache->get($key), $value,            'get returns cached value (not expired)');
  87 $cache->set_expires_in(0);
  88 is($cache->get_expires_in(), 0,          '"expires in" is set to now (0)');
  89 $cache->set($key, $value);
  90 ok(!defined($cache->get($key)),          'cache is expired');
  91
  92 done_testing();
  93
  94 print Dumper($cache);