This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
[perl5.git] / lib / FileCache.t
CommitLineData
1a3850a5
GA
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
1a3850a5
GA
6}
7
c14fc35a 8print "1..5\n";
1a3850a5 9
c14fc35a
JH
10use FileCache maxopen=>2;
11my @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
75q(
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 911 while unlink @files, "Foo_Bar";