1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
print "1..5\n";
use FileCache maxopen=>2;
my @files = qw(foo bar baz quux);
{# Test 1: that we can open files
for my $path ( @files ){
cacheout $path;
print $path "$path 1\n";
}
print "not " unless scalar map({ -f } @files) == 4;
print "ok 1\n";
}
{# Test 2: that we actually adhere to maxopen
my @cat;
for my $path ( @files ){
print $path "$path 2\n";
close($path);
open($path, $path);
<$path>;
push @cat, <$path>;
close($path);
}
print "not " if (grep {/foo|bar/} @cat) && ! (grep {/baz|quux/} @cat);
print "ok 2\n" ;
}
{# Test 3: that we open for append on second viewing
my @cat;
for my $path ( @files ){
cacheout $path;
print $path "$path 3\n";
}
for my $path ( @files ){
open($path, $path);
push @cat, do{ local $/; <$path>};
close($path);
}
print "not " unless scalar map({ /3$/ } @cat) == 4;
print "ok 3\n";
}
{# Test 4: that 2 arg format works
cacheout '+<', "foo";
print foo "foo 2\n";
close foo;
cacheout '<', "foo";
print "not " unless <foo> eq "foo 2\n";
print "ok 4\n";
close(foo);
}
{# Test 5: that close is overridden properly
cacheout local $_ = "Foo_Bar";
print $_ "Hello World\n";
close($_);
open($_, "+>$_");
print $_ "$_\n";
seek($_, 0, 0);
print "not " unless <$_> eq "$_\n";
print "ok 5\n";
close($_);
}
q(
{# Test close override
package Bob;
use FileCache;
cacheout local $_ = "Foo_Bar";
print $_ "Hello World\n";
close($_);
open($_, "+>$_");
print $_ "$_\n";
seek($_, 0, 0);
print "not " unless <$_> eq "$_\n";
print "ok 5\n";
close($_);
}
);
1 while unlink @files, "Foo_Bar";
|
