1#!/usr/bin/perl
2
3use lib 'blib/lib';
4use Memoize 0.45 qw(memoize unmemoize);
5use Fcntl;
6
7# print STDERR $INC{'Memoize.pm'}, "\n";
8
9print "1..10\n";
10
11# Test MERGE
12sub xx {
13  wantarray();
14}
15
16my $s = xx();
17print ((!$s) ? "ok 1\n" : "not ok 1\n");
18my ($a) = xx();
19print (($a) ? "ok 2\n" : "not ok 2\n");
20memoize 'xx', LIST_CACHE => MERGE;
21$s = xx();
22print ((!$s) ? "ok 3\n" : "not ok 3\n");
23($a) = xx();  # Should return cached false value from previous invocation
24print ((!$a) ? "ok 4\n" : "not ok 4\n");
25
26
27# Test FAULT
28sub ns {}
29sub na {}
30memoize 'ns', SCALAR_CACHE => FAULT;
31memoize 'na', LIST_CACHE => FAULT;
32eval { my $s = ns() };  # Should fault
33print (($@) ?  "ok 5\n" : "not ok 5\n");
34eval { my ($a) = na() };  # Should fault
35print (($@) ?  "ok 6\n" : "not ok 6\n");
36
37
38# Test HASH
39my (%s, %l);
40sub nul {}
41memoize 'nul', SCALAR_CACHE => [HASH => \%s], LIST_CACHE => [HASH => \%l];
42nul('x');
43nul('y');
44print ((join '', sort keys %s) eq 'xy' ? "ok 7\n" : "not ok 7\n");
45print ((join '', sort keys %l) eq ''   ? "ok 8\n" : "not ok 8\n");
46() = nul('p');
47() = nul('q');
48print ((join '', sort keys %s) eq 'xy' ? "ok 9\n" : "not ok 9\n");
49print ((join '', sort keys %l) eq 'pq' ? "ok 10\n" : "not ok 10\n");
50
51