| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | @INC = '../lib'; |
| 6 | } |
| 7 | |
| 8 | print "1..5\n"; |
| 9 | |
| 10 | use FileCache maxopen=>2; |
| 11 | my @files = qw(foo bar baz quux); |
| 12 | |
| 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 | } |
| 21 | |
| 22 | |
| 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 | } |
| 36 | |
| 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 | } |
| 51 | |
| 52 | |
| 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 | close(foo); |
| 61 | } |
| 62 | |
| 63 | {# Test 5: that close is overridden properly |
| 64 | cacheout local $_ = "Foo_Bar"; |
| 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"; |
| 72 | close($_); |
| 73 | } |
| 74 | |
| 75 | q( |
| 76 | {# Test close override |
| 77 | package Bob; |
| 78 | use FileCache; |
| 79 | cacheout local $_ = "Foo_Bar"; |
| 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"; |
| 87 | close($_); |
| 88 | } |
| 89 | ); |
| 90 | |
| 91 | 1 while unlink @files, "Foo_Bar"; |