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