tiefeatures.t

source of perl for linux application,

#!/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");