The FileCache 1.03 tests from belg4mit.

p4raw-id: //depot/perl@19783

diff --git a/MANIFEST b/MANIFEST
index 76dbe58..393c237 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1192,7 +1192,11 @@ lib/File/Temp/t/posix.t          See if File::Temp works
 lib/File/Temp/t/security.t     See if File::Temp works
 lib/File/Temp/t/tempfile.t     See if File::Temp works
 lib/FileCache.pm               Keep more files open than the system permits
-lib/FileCache.t                        See if FileCache works
+lib/FileCache/t/01open.t       See if FileCache works
+lib/FileCache/t/02maxopen.t    See if FileCache works
+lib/FileCache/t/03append.t     See if FileCache works
+lib/FileCache/t/04twoarg.t     See if FileCache works
+lib/FileCache/t/05override.t   See if FileCache works
 lib/FileHandle.pm              Backward-compatible front end to IO extension
 lib/FileHandle.t               See if FileHandle works
 lib/filetest.pm                        For "use filetest"

diff --git a/lib/FileCache.t b/lib/FileCache.t
deleted file mode 100755 (executable)
index 1d91d21..0000000
--- a/lib/FileCache.t
+++ /dev/null
@@ -1,91 +0,0 @@
-#!./perl
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-print "1..5\n";
-
-use FileCache maxopen=>2;
-my @files = qw(foo bar baz quux);
-
-{# 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";
-}
-
-
-{# 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" ;
-}
-
-{# 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";
-}
-
-
-{# 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";

diff --git a/lib/FileCache/t/01open.t b/lib/FileCache/t/01open.t
new file mode 100644 (file)
index 0000000..d516aea
--- /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 (file)
index 0000000..6b3b4c8
--- /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 (file)
index 0000000..5a08a1e
--- /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 (file)
index 0000000..a2a70be
--- /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 (file)
index 0000000..6fdf873
--- /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";
+}