1# Before `make install' is performed this script should be runnable with 2# `make test'. After `make install' it should work as `perl test.pl' 3 4######################### We start with some black magic to print on failure. 5 6# Change 1..1 below to 1..last_test_to_print . 7# (It may become useful if the test is moved to ./t subdirectory.) 8 9BEGIN { $| = 1; print "1..9\n"; } 10END {print "not ok 1\n" unless $loaded;} 11use IPC::SharedCache; 12$loaded = 1; 13print "ok 1\n"; 14 15######################### End of black magic. 16 17# Insert your test code below (better if it prints "ok 13" 18# (correspondingly "not ok 13") depending on the success of chunk 13 19# of the test code): 20 21use IPC::SharedCache; 22 23local($^W) = 1; 24 25# test creation 26my %cache; 27tie %cache, 'IPC::SharedCache', 28 ipc_key => 'MYKI', 29 load_callback => sub { return [time(), time(), time()] }, 30 validate_callback => sub { return 1; }, 31 debug => 0; 32print "ok 2\n"; 33 34# test load 35my $time_array = $cache{'some_key'}; 36die "not ok 3\n" unless defined($time_array); 37die "not ok 3\n" unless ref($time_array) eq 'ARRAY'; 38print "ok 3\n"; 39 40# test delete/exists 41delete($cache{'some_key'}); 42die "not ok 4\n" if exists($cache{'some_key'}); 43print "ok 4\n"; 44 45# test delete/exists 46$time_array = $cache{'some_other_key'}; 47die "not ok 5\n" unless exists($cache{'some_other_key'}); 48print "ok 5\n"; 49delete($cache{'some_other_key'}); 50 51# test keys/each 52my $a = $cache{'a'}; 53my $b = $cache{'b'}; 54my $c = $cache{'c'}; 55die "not ok 6\n" unless keys(%cache) == 3; 56die "not ok 6\n" unless (keys(%cache))[0] eq 'a'; 57die "not ok 6\n" unless (keys(%cache))[1] eq 'b'; 58die "not ok 6\n" unless (keys(%cache))[2] eq 'c'; 59my @keys = keys(%cache); 60for (my $x = 0; $x < 3; $x++) { 61 die "not ok 6\n" 62 unless ($keys[$x] eq scalar(each(%cache))); 63} 64delete($cache{'a'}); 65die "not ok 6\n" unless keys(%cache) == 2; 66die "not ok 6\n" unless (keys(%cache))[0] eq 'b'; 67die "not ok 6\n" unless (keys(%cache))[1] eq 'c'; 68delete($cache{'b'}); 69die "not ok 6\n" unless keys(%cache) == 1; 70die "not ok 6\n" unless (keys(%cache))[0] eq 'c'; 71delete($cache{'c'}); 72die "not ok 6\n" unless keys(%cache) == 0; 73print "ok 6\n"; 74 75# clean up with remove 76untie %cache; 77IPC::SharedCache::remove('MYKI'); 78 79# test max_size 80my %mcache; 81tie %mcache, 'IPC::SharedCache', 82 ipc_key => 'MYKI', 83 load_callback => sub { my $data = 'a' x 1024; return [ $data ]; }, 84 validate_callback => sub { return 1; }, 85 max_size => 4500, 86 debug => 0; 87print "ok 7\n"; 88 89# fill the cache 90my $f = $mcache{'f'}; 91my $g = $mcache{'g'}; 92my $h = $mcache{'h'}; 93my $i = $mcache{'i'}; 94die "not ok 8\n" unless scalar(keys(%mcache)) == 4; 95print "ok 8\n"; 96 97# this should make the cache delete 'f' by crossing max_size: 98my $j = $mcache{'j'}; 99die "not ok 9\n" unless keys(%mcache) == 4; 100die "not ok 9\n" unless (keys(%mcache))[0] eq 'g'; 101die "not ok 9\n" unless (keys(%mcache))[1] eq 'h'; 102die "not ok 9\n" unless (keys(%mcache))[2] eq 'i'; 103die "not ok 9\n" unless (keys(%mcache))[3] eq 'j'; 104print "ok 9\n"; 105 106# clean up 107untie %mcache; 108IPC::SharedCache::remove('MYKI'); 109 110#my %cache; 111#tie %cache, 'IPC::SharedCache', 112# ipc_key => 'MYKI', 113# load_callback => sub { die "blah" }, 114# validate_callback => sub { return 1; }, 115# max_size => 4500, 116# debug => 0; 117#print "ok 10\n"; 118# 119#my $z = $cache{'z'}; 120# 121#{ 122# print "ok 11\n"; 123#} 124# IPC::SharedCache::remove('MYKI'); 125