Commit | Line | Data |
---|---|---|
1a3850a5 GA |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
20822f61 | 5 | @INC = '../lib'; |
1a3850a5 GA |
6 | } |
7 | ||
c14fc35a | 8 | print "1..5\n"; |
1a3850a5 | 9 | |
c14fc35a JH |
10 | use FileCache maxopen=>2; |
11 | my @files = qw(foo bar baz quux); | |
1a3850a5 | 12 | |
c14fc35a JH |
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 JH |
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 JH |
28 | open($path, $path); |
29 | <$path>; | |
30 | push @cat, <$path>; | |
0ec158f4 | 31 | close($path); |
c14fc35a JH |
32 | } |
33 | print "not " if (grep {/foo|bar/} @cat) && ! (grep {/baz|quux/} @cat); | |
34 | print "ok 2\n" ; | |
35 | } | |
1a3850a5 | 36 | |
c14fc35a JH |
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 JH |
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 JH |
61 | } |
62 | ||
63 | {# Test 5: that close is overridden properly | |
58858581 | 64 | cacheout local $_ = "Foo_Bar"; |
c14fc35a JH |
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 JH |
73 | } |
74 | ||
75 | q( | |
76 | {# Test close override | |
77 | package Bob; | |
78 | use FileCache; | |
58858581 | 79 | cacheout local $_ = "Foo_Bar"; |
c14fc35a JH |
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 JH |
88 | } |
89 | ); | |
90 | ||
58858581 | 91 | 1 while unlink @files, "Foo_Bar"; |