summaryrefslogtreecommitdiff
path: root/lib/Memoize/t/tiefeatures.t
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Memoize/t/tiefeatures.t')
-rwxr-xr-xlib/Memoize/t/tiefeatures.t50
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");
+