File: test.pl

package info (click to toggle)
libipc-sharedcache-perl 1.3-9.1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 244 kB
  • sloc: perl: 1,386; makefile: 2
file content (124 lines) | stat: -rw-r--r-- 3,317 bytes parent folder | download | duplicates (5)
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
117
118
119
120
121
122
123
124
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..9\n"; }
END {print "not ok 1\n" unless $loaded;}
use IPC::SharedCache;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

use IPC::SharedCache;

local($^W) = 1;

# test creation
my %cache;
tie %cache, 'IPC::SharedCache', 
  ipc_key => 'MYKI',
  load_callback => sub { return [time(), time(), time()] },
  validate_callback => sub { return 1; },
  debug => 0;
print "ok 2\n";

# test load
my $time_array = $cache{'some_key'};
die "not ok 3\n" unless defined($time_array);
die "not ok 3\n" unless ref($time_array) eq 'ARRAY';
print "ok 3\n";

# test delete/exists
delete($cache{'some_key'});
die "not ok 4\n" if exists($cache{'some_key'});
print "ok 4\n";

# test delete/exists
$time_array = $cache{'some_other_key'};
die "not ok 5\n" unless exists($cache{'some_other_key'});
print "ok 5\n";
delete($cache{'some_other_key'});

# test keys/each
my $a = $cache{'a'};
my $b = $cache{'b'};
my $c = $cache{'c'};
die "not ok 6\n" unless keys(%cache) == 3;
die "not ok 6\n" unless (keys(%cache))[0] eq 'a';
die "not ok 6\n" unless (keys(%cache))[1] eq 'b';
die "not ok 6\n" unless (keys(%cache))[2] eq 'c';
my @keys = keys(%cache);
for (my $x = 0; $x < 3; $x++) {
  die "not ok 6\n"
    unless ($keys[$x] eq scalar(each(%cache)));
}
delete($cache{'a'});
die "not ok 6\n" unless keys(%cache) == 2;
die "not ok 6\n" unless (keys(%cache))[0] eq 'b';
die "not ok 6\n" unless (keys(%cache))[1] eq 'c';
delete($cache{'b'});
die "not ok 6\n" unless keys(%cache) == 1;
die "not ok 6\n" unless (keys(%cache))[0] eq 'c';
delete($cache{'c'});
die "not ok 6\n" unless keys(%cache) == 0;
print "ok 6\n";

# clean up with remove
untie %cache;
IPC::SharedCache::remove('MYKI');

# test max_size
my %mcache;
tie %mcache, 'IPC::SharedCache', 
  ipc_key => 'MYKI',
  load_callback => sub { my $data = 'a' x 1024; return [ $data ]; },
  validate_callback => sub { return 1; },
  max_size => 4500,
  debug => 0;
print "ok 7\n";

# fill the cache
my $f = $mcache{'f'};
my $g = $mcache{'g'};
my $h = $mcache{'h'};
my $i = $mcache{'i'};
die "not ok 8\n" unless scalar(keys(%mcache)) == 4;
print "ok 8\n";

# this should make the cache delete 'f' by crossing max_size:
my $j = $mcache{'j'};
die "not ok 9\n" unless keys(%mcache) == 4;
die "not ok 9\n" unless (keys(%mcache))[0] eq 'g';
die "not ok 9\n" unless (keys(%mcache))[1] eq 'h';
die "not ok 9\n" unless (keys(%mcache))[2] eq 'i';
die "not ok 9\n" unless (keys(%mcache))[3] eq 'j';
print "ok 9\n";

# clean up
untie %mcache;
IPC::SharedCache::remove('MYKI');

#my %cache;
#tie %cache, 'IPC::SharedCache', 
#  ipc_key => 'MYKI',
#  load_callback => sub { die "blah" },
#  validate_callback => sub { return 1; },
#  max_size => 4500,
#  debug => 0;
#print "ok 10\n";
#
#my $z = $cache{'z'};
#
#{ 
#  print "ok 11\n";
#}
# IPC::SharedCache::remove('MYKI');