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$file = "md$$"; 321 while unlink $file, "$file.dir", "$file.pag", "$file.db"; 33tryout('Memoize::NDBM_File', $file, 1); # Test 1..4 341 while unlink $file, "$file.dir", "$file.pag", "$file.db"; 35 36sub tryout { 37 my ($tiepack, $file, $testno) = @_; 38 39 40 tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666 41 or die $!; 42 43 memoize 'c5', 44 SCALAR_CACHE => [HASH => \%cache], 45 LIST_CACHE => 'FAULT' 46 ; 47 48 my $t1 = c5(); 49 my $t2 = c5(); 50 print (($t1 == 5) ? "ok $testno\n" : "not ok $testno\n"); 51 $testno++; 52 print (($t2 == 5) ? "ok $testno\n" : "not ok $testno\n"); 53 unmemoize 'c5'; 54 55 # Now something tricky---we'll memoize c23 with the wrong table that 56 # has the 5 already cached. 57 memoize 'c23', 58 SCALAR_CACHE => [HASH => \%cache], 59 LIST_CACHE => 'FAULT' 60 ; 61 62 my $t3 = c23(); 63 my $t4 = c23(); 64 $testno++; 65 print (($t3 == 5) ? "ok $testno\n" : "not ok $testno\n"); 66 $testno++; 67 print (($t4 == 5) ? "ok $testno\n" : "not ok $testno\n"); 68 unmemoize 'c23'; 69} 70 71