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