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