X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFileCache.t;h=1d91d210ab8c2400fc17f154350c3cefe5cbe67c;hb=83272a45226e83bd136d713158e9b44ace2dbc8d;hp=a97fdd532c6c217f43038c6448c3d288f93d6f50;hpb=b695f709e8a342e35e482b0437eb6cdacdc58b6b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/FileCache.t b/lib/FileCache.t
index a97fdd5..1d91d21 100755
--- a/lib/FileCache.t
+++ b/lib/FileCache.t
@@ -5,21 +5,87 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..1\n";
+print "1..5\n";
 
-use FileCache;
+use FileCache maxopen=>2;
+my @files = qw(foo bar baz quux);
 
-# This is really not a complete test as I don't bother to open enough
-# files to make real swapping of open filedescriptor happen.
+{# Test 1: that we can open files
+     for my $path ( @files ){
+	 cacheout $path;
+	 print $path "$path 1\n";
+     }
+     print "not " unless scalar map({ -f } @files) == 4;
+     print "ok 1\n";
+}
 
-$path = "foo";
-cacheout $path;
 
-print $path "\n";
+{# Test 2: that we actually adhere to maxopen
+    my @cat;
+    for my $path ( @files ){
+	print $path "$path 2\n";
+        close($path);
+	open($path, $path);
+	<$path>;
+	push @cat, <$path>;
+        close($path);
+    }
+    print "not " if (grep {/foo|bar/} @cat) && ! (grep {/baz|quux/} @cat);
+    print "ok 2\n" ;
+}
 
-close $path;
+{# Test 3: that we open for append on second viewing
+     my @cat;
+     for my $path ( @files ){
+	 cacheout $path;
+	 print $path "$path 3\n";
+     }
+     for my $path ( @files ){
+	 open($path, $path);
+	 push @cat, do{ local $/; <$path>};
+         close($path);
+     }
+     print "not " unless scalar map({ /3$/ } @cat) == 4;
+     print "ok 3\n";
+}
 
-print "not " unless -f $path;
-print "ok 1\n";
 
-unlink $path;
+{# Test 4: that 2 arg format works
+     cacheout '+<', "foo";
+     print foo "foo 2\n";
+     close foo;
+     cacheout '<', "foo";
+     print "not " unless <foo> eq "foo 2\n";
+     print "ok 4\n";
+     close(foo);
+}
+
+{# Test 5: that close is overridden properly
+     cacheout local $_ = "Foo_Bar";
+     print $_ "Hello World\n";
+     close($_);
+     open($_, "+>$_");
+     print $_ "$_\n";
+     seek($_, 0, 0);
+     print "not " unless <$_> eq "$_\n";
+     print "ok 5\n";
+     close($_);
+}
+
+q(
+{# Test close override
+     package Bob;
+     use FileCache;
+     cacheout local $_ = "Foo_Bar";
+     print $_ "Hello World\n";
+     close($_);
+     open($_, "+>$_");
+     print $_ "$_\n";
+     seek($_, 0, 0);
+     print "not " unless <$_> eq "$_\n";
+     print "ok 5\n";
+     close($_);
+}
+);
+
+1 while unlink @files, "Foo_Bar";