From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sat, 14 Jun 2003 16:30:23 +0000 (+0000)
Subject: The FileCache 1.03 tests from belg4mit.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1673d79ec73dea09f6ee503fbe23e5c7945eba82;p=p5sagit%2Fp5-mst-13.2.git

The FileCache 1.03 tests from belg4mit.

p4raw-id: //depot/perl@19783
---

diff --git a/MANIFEST b/MANIFEST
index 76dbe58..393c237 100644
--- 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
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
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
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
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
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
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";
+}