Integrate mainline into perlio
[p5sagit/p5-mst-13.2.git] / lib / FileCache.t
CommitLineData
1a3850a5 1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
1a3850a5 6}
7
c14fc35a 8print "1..5\n";
1a3850a5 9
c14fc35a 10use FileCache maxopen=>2;
11my @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
58858581 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
73q(
74{# Test close override
75 package Bob;
76 use FileCache;
58858581 77 cacheout local $_ = "Foo_Bar";
c14fc35a 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
58858581 881 while unlink @files, "Foo_Bar";