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