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"; |
27 | close($path); |
28 | open($path, $path); |
29 | <$path>; |
30 | push @cat, <$path>; |
31 | close($path); |
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"; |
60 | } |
61 | |
62 | {# Test 5: that close is overridden properly |
77fcdeeb |
63 | cacheout local $_ = "Foo'Bar"; |
c14fc35a |
64 | print $_ "Hello World\n"; |
65 | close($_); |
66 | open($_, "+>$_"); |
67 | print $_ "$_\n"; |
68 | seek($_, 0, 0); |
69 | print "not " unless <$_> eq "$_\n"; |
70 | print "ok 5\n"; |
71 | } |
72 | |
73 | q( |
74 | {# Test close override |
75 | package Bob; |
76 | use FileCache; |
77 | cacheout local $_ = "Foo'Bar"; |
78 | print $_ "Hello World\n"; |
79 | close($_); |
80 | open($_, "+>$_"); |
81 | print $_ "$_\n"; |
82 | seek($_, 0, 0); |
83 | print "not " unless <$_> eq "$_\n"; |
84 | print "ok 5\n"; |
85 | } |
86 | ); |
87 | |
88 | unlink @files, "Foo'Bar"; |