diff options
Diffstat (limited to 'lib/Memoize/t/tiefeatures.t')
-rwxr-xr-x | lib/Memoize/t/tiefeatures.t | 50 |
1 files changed, 50 insertions, 0 deletions
diff --git a/lib/Memoize/t/tiefeatures.t b/lib/Memoize/t/tiefeatures.t new file mode 100755 index 0000000000..7306d9f4f8 --- /dev/null +++ b/lib/Memoize/t/tiefeatures.t @@ -0,0 +1,50 @@ +#!/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"); + |