The FileCache 1.03 tests from belg4mit.

p4raw-id: //depot/perl@19783

5 files changed, 154 insertions, 0 deletions

diff --git a/lib/FileCache/t/01open.t b/lib/FileCache/t/01open.t
new file mode 100644
index 0000000000..d516aea2d0
--- /dev/null
+++ b/lib/FileCache/t/01open.t
@@ -0,0 +1,26 @@
+#!./perl
+use FileCache;
+use vars qw(@files);
+BEGIN {
+    @files = qw(foo bar baz quux Foo'Bar);
+    chdir 't' if -d 't';
+
+    #For tests within the perl distribution
+    @INC = '../lib' if -d '../lib';
+    END;
+}
+END{
+  unlink @files;
+}
+
+
+print "1..1\n";
+
+{# 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) == scalar @files;
+     print "ok 1\n";
+}
diff --git a/lib/FileCache/t/02maxopen.t b/lib/FileCache/t/02maxopen.t
new file mode 100644
index 0000000000..6b3b4c86e7
--- /dev/null
+++ b/lib/FileCache/t/02maxopen.t
@@ -0,0 +1,36 @@
+#!./perl
+use FileCache maxopen=>2;
+use Test;
+use vars qw(@files);
+BEGIN {
+    @files = qw(foo bar baz quux);
+    chdir 't' if -d 't';
+
+    #For tests within the perl distribution
+    @INC = '../lib' if -d '../lib';
+    END;
+    plan tests=>5;
+}
+END{
+  unlink @files;
+}
+
+{# Test 2: that we actually adhere to maxopen
+  for my $path ( @files ){
+    cacheout $path;
+    print $path "$path 1\n";
+  }
+  
+  my @cat;
+  for my $path ( @files ){
+    ok(fileno($path) || $path =~ /^(?:foo|bar)$/);
+    next unless fileno($path);
+    print $path "$path 2\n";
+    close($path);
+    open($path, $path);
+    <$path>;
+    push @cat, <$path>;
+    close($path);
+  }
+  ok( grep(/^(?:baz|quux) 2$/, @cat) == 2 );
+}
diff --git a/lib/FileCache/t/03append.t b/lib/FileCache/t/03append.t
new file mode 100644
index 0000000000..5a08a1e779
--- /dev/null
+++ b/lib/FileCache/t/03append.t
@@ -0,0 +1,47 @@
+#!./perl
+use FileCache maxopen=>2;
+use vars qw(@files);
+BEGIN {
+    @files = qw(foo bar baz quux Foo'Bar);
+    chdir 't' if -d 't';
+
+    #For tests within the perl distribution
+    @INC = '../lib' if -d '../lib';
+    END;
+}
+END{
+  unlink @files;
+}
+
+print "1..2\n";
+
+{# 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 ){
+	 cacheout $path;
+	 print $path "$path 33\n";
+     }
+     for my $path ( @files ){
+	 open($path, '<', $path);
+	 push @cat, do{ local $/; <$path>};
+         close($path);
+     }
+     print 'not ' unless scalar grep(/\b3$/m, @cat) == scalar @files;
+     print "ok 1\n";
+     @cat = ();
+     for my $path ( @files ){
+	 cacheout $path;
+	 print $path "$path 333\n";
+     }
+     for my $path ( @files ){
+	 open($path, '<', $path);
+	 push @cat, do{ local $/; <$path>};
+         close($path);
+     }
+     print 'not ' unless scalar grep(/\b33$/m, @cat) == scalar @files;
+     print "ok 2\n";
+}
diff --git a/lib/FileCache/t/04twoarg.t b/lib/FileCache/t/04twoarg.t
new file mode 100644
index 0000000000..a2a70be2b6
--- /dev/null
+++ b/lib/FileCache/t/04twoarg.t
@@ -0,0 +1,24 @@
+#!./perl
+BEGIN {
+    use FileCache;
+    chdir 't' if -d 't';
+
+    #For tests within the perl distribution
+    @INC = '../lib' if -d '../lib';
+    END;
+}
+END{
+  unlink('foo');
+}
+
+print "1..1\n";
+
+{# Test 4: that 2 arg format works, and that we cycle on mode change
+     cacheout '>', "foo";
+     print foo "foo 4\n";
+     cacheout '+>', "foo";
+     print foo "foo 44\n";
+     seek(foo, 0, 0);
+     print 'not ' unless <foo> eq "foo 44\n";
+     print "ok 1\n";
+}
diff --git a/lib/FileCache/t/05override.t b/lib/FileCache/t/05override.t
new file mode 100644
index 0000000000..6fdf873600
--- /dev/null
+++ b/lib/FileCache/t/05override.t
@@ -0,0 +1,21 @@
+#!./perl
+BEGIN {
+    use FileCache;
+    chdir 't' if -d 't';
+
+    #For tests within the perl distribution
+    @INC = '../lib' if -d '../lib';
+    END;
+}
+END{
+  unlink("Foo'Bar");
+}
+print "1..1\n";
+
+{# Test 5: that close is overridden properly within the caller
+     cacheout local $_ = "Foo'Bar";
+     print $_ "Hello World\n";
+     close($_);
+     print 'not ' if fileno($_);
+     print "ok 1\n";
+}