Error in the latest FindBin patch, noticed by Nicholas
[p5sagit/p5-mst-13.2.git] / lib / Memoize / t / tie_ndbm.t
CommitLineData
a0cb3900 1#!/usr/bin/perl
2
484fdf61 3use lib qw(. ..);
a0cb3900 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
2359510d 31$file = "md$$";
cacf81f4 321 while unlink $file, "$file.dir", "$file.pag", "$file.db";
a0cb3900 33tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
cacf81f4 341 while unlink $file, "$file.dir", "$file.pag", "$file.db";
a0cb3900 35
36sub tryout {
37 my ($tiepack, $file, $testno) = @_;
38
39
899dc88a 40 tie my %cache => $tiepack, $file, O_RDWR | O_CREAT, 0666
41 or die $!;
42
a0cb3900 43 memoize 'c5',
899dc88a 44 SCALAR_CACHE => [HASH => \%cache],
a0cb3900 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',
899dc88a 58 SCALAR_CACHE => [HASH => \%cache],
a0cb3900 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