1*0Sstevel@tonic-gate#!/usr/bin/perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateuse lib qw(. ..); 4*0Sstevel@tonic-gateuse Memoize 0.52 qw(memoize unmemoize); 5*0Sstevel@tonic-gateuse Fcntl; 6*0Sstevel@tonic-gateeval {require Memoize::AnyDBM_File}; 7*0Sstevel@tonic-gateif ($@) { 8*0Sstevel@tonic-gate print "1..0\n"; 9*0Sstevel@tonic-gate exit 0; 10*0Sstevel@tonic-gate} 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gateprint "1..4\n"; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gatesub i { 17*0Sstevel@tonic-gate $_[0]; 18*0Sstevel@tonic-gate} 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gate$ARG = 'Keith Bostic is a pinhead'; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gatesub c119 { 119 } 23*0Sstevel@tonic-gatesub c7 { 7 } 24*0Sstevel@tonic-gatesub c43 { 43 } 25*0Sstevel@tonic-gatesub c23 { 23 } 26*0Sstevel@tonic-gatesub c5 { 5 } 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gatesub n { 29*0Sstevel@tonic-gate $_[0]+1; 30*0Sstevel@tonic-gate} 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gateif (eval {require File::Spec::Functions}) { 33*0Sstevel@tonic-gate File::Spec::Functions->import('tmpdir', 'catfile'); 34*0Sstevel@tonic-gate $tmpdir = tmpdir(); 35*0Sstevel@tonic-gate} else { 36*0Sstevel@tonic-gate *catfile = sub { join '/', @_ }; 37*0Sstevel@tonic-gate $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp'; 38*0Sstevel@tonic-gate} 39*0Sstevel@tonic-gate$file = catfile($tmpdir, "md$$"); 40*0Sstevel@tonic-gate@files = ($file, "$file.db", "$file.dir", "$file.pag"); 41*0Sstevel@tonic-gate1 while unlink @files; 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gatetryout('Memoize::AnyDBM_File', $file, 1); # Test 1..4 45*0Sstevel@tonic-gate# tryout('DB_File', $file, 1); # Test 1..4 46*0Sstevel@tonic-gate1 while unlink $file, "$file.dir", "$file.pag"; 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gatesub tryout { 49*0Sstevel@tonic-gate my ($tiepack, $file, $testno) = @_; 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gate tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666 52*0Sstevel@tonic-gate or die $!; 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate memoize 'c5', 55*0Sstevel@tonic-gate SCALAR_CACHE => [HASH => \%cache], 56*0Sstevel@tonic-gate LIST_CACHE => 'FAULT' 57*0Sstevel@tonic-gate ; 58*0Sstevel@tonic-gate 59*0Sstevel@tonic-gate my $t1 = c5($ARG); 60*0Sstevel@tonic-gate my $t2 = c5($ARG); 61*0Sstevel@tonic-gate print (($t1 == 5) ? "ok $testno\n" : "not ok $testno\n"); 62*0Sstevel@tonic-gate $testno++; 63*0Sstevel@tonic-gate print (($t2 == 5) ? "ok $testno\n" : "not ok $testno\n"); 64*0Sstevel@tonic-gate unmemoize 'c5'; 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gate # Now something tricky---we'll memoize c23 with the wrong table that 67*0Sstevel@tonic-gate # has the 5 already cached. 68*0Sstevel@tonic-gate memoize 'c23', 69*0Sstevel@tonic-gate SCALAR_CACHE => ['HASH', \%cache], 70*0Sstevel@tonic-gate LIST_CACHE => 'FAULT' 71*0Sstevel@tonic-gate ; 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate my $t3 = c23($ARG); 74*0Sstevel@tonic-gate my $t4 = c23($ARG); 75*0Sstevel@tonic-gate $testno++; 76*0Sstevel@tonic-gate print (($t3 == 5) ? "ok $testno\n" : "not ok $testno # Result $t3\n"); 77*0Sstevel@tonic-gate $testno++; 78*0Sstevel@tonic-gate print (($t4 == 5) ? "ok $testno\n" : "not ok $testno # Result $t4\n"); 79*0Sstevel@tonic-gate unmemoize 'c23'; 80*0Sstevel@tonic-gate} 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gate{ 83*0Sstevel@tonic-gate my @present = grep -e, @files; 84*0Sstevel@tonic-gate if (@present && (@failed = grep { not unlink } @present)) { 85*0Sstevel@tonic-gate warn "Can't unlink @failed! ($!)"; 86*0Sstevel@tonic-gate } 87*0Sstevel@tonic-gate} 88