#!/usr/bin/perl use lib 'blib/lib'; use Memoize 0.45 qw(memoize unmemoize); use Fcntl; # print STDERR $INC{'Memoize.pm'}, "\n"; print "1..10\n"; # Test MERGE sub xx { wantarray(); } my $s = xx(); print ((!$s) ? "ok 1\n" : "not ok 1\n"); my ($a) = xx(); print (($a) ? "ok 2\n" : "not ok 2\n"); memoize 'xx', LIST_CACHE => MERGE; $s = xx(); print ((!$s) ? "ok 3\n" : "not ok 3\n"); ($a) = xx(); # Should return cached false value from previous invocation print ((!$a) ? "ok 4\n" : "not ok 4\n"); # Test FAULT sub ns {} sub na {} memoize 'ns', SCALAR_CACHE => FAULT; memoize 'na', LIST_CACHE => FAULT; eval { my $s = ns() }; # Should fault print (($@) ? "ok 5\n" : "not ok 5\n"); eval { my ($a) = na() }; # Should fault print (($@) ? "ok 6\n" : "not ok 6\n"); # Test HASH my (%s, %l); sub nul {} memoize 'nul', SCALAR_CACHE => [HASH => \%s], LIST_CACHE => [HASH => \%l]; nul('x'); nul('y'); print ((join '', sort keys %s) eq 'xy' ? "ok 7\n" : "not ok 7\n"); print ((join '', sort keys %l) eq '' ? "ok 8\n" : "not ok 8\n"); () = nul('p'); () = nul('q'); print ((join '', sort keys %s) eq 'xy' ? "ok 9\n" : "not ok 9\n"); print ((join '', sort keys %l) eq 'pq' ? "ok 10\n" : "not ok 10\n");