1#!/usr/bin/perl 2 3use lib qw(. ..); 4use Memoize 0.45 qw(memoize unmemoize); 5use Fcntl; 6# use Memoize::NDBM_File; 7# $Memoize::NDBM_File::Verbose = 0; 8 9sub i { 10 $_[0]; 11} 12 13sub c119 { 119 } 14sub c7 { 7 } 15sub c43 { 43 } 16sub c23 { 23 } 17sub c5 { 5 } 18 19sub n { 20 $_[0]+1; 21} 22 23eval {require Memoize::NDBM_File}; 24if ($@) { 25 print "1..0\n"; 26 exit 0; 27} 28 29print "1..4\n"; 30 31 32if (eval {require File::Spec::Functions}) { 33 File::Spec::Functions->import(); 34} else { 35 *catfile = sub { join '/', @_ }; 36} 37$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp'; 38$file = catfile($tmpdir, "md$$"); 391 while unlink $file, "$file.dir", "$file.pag"; 40tryout('Memoize::NDBM_File', $file, 1); # Test 1..4 411 while unlink $file, "$file.dir", "$file.pag"; 42 43sub tryout { 44 my ($tiepack, $file, $testno) = @_; 45 46 47 tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666 48 or die $!; 49 50 memoize 'c5', 51 SCALAR_CACHE => [HASH => \%cache], 52 LIST_CACHE => 'FAULT' 53 ; 54 55 my $t1 = c5(); 56 my $t2 = c5(); 57 print (($t1 == 5) ? "ok $testno\n" : "not ok $testno\n"); 58 $testno++; 59 print (($t2 == 5) ? "ok $testno\n" : "not ok $testno\n"); 60 unmemoize 'c5'; 61 62 # Now something tricky---we'll memoize c23 with the wrong table that 63 # has the 5 already cached. 64 memoize 'c23', 65 SCALAR_CACHE => [HASH => \%cache], 66 LIST_CACHE => 'FAULT' 67 ; 68 69 my $t3 = c23(); 70 my $t4 = c23(); 71 $testno++; 72 print (($t3 == 5) ? "ok $testno\n" : "not ok $testno\n"); 73 $testno++; 74 print (($t4 == 5) ? "ok $testno\n" : "not ok $testno\n"); 75 unmemoize 'c23'; 76} 77 78