FileCache 1.02, from Jerrad Pierce <belg4mit@MIT.EDU>.

[p5sagit/p5-mst-13.2.git] / lib / FileCache.t

diff --git a/lib/FileCache.t b/lib/FileCache.t
index a97fdd5..9e28270 100755 (executable)
--- a/lib/FileCache.t
+++ b/lib/FileCache.t
@@ -5,21 +5,84 @@ 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";
+}
+
+{# 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";
+}
+
+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";
+}
+);
+
+unlink @files, "Foo'Bar";