dslinux/user/perl/lib/FileCache/t 01open.t 02maxopen.t 03append.t 04twoarg.t 05override.t 06export.t 07noimport.t
cayenne
dslinux_cayenne at user.in-berlin.de
Tue Dec 5 05:27:09 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/FileCache/t
In directory antilope:/tmp/cvs-serv7729/lib/FileCache/t
Added Files:
01open.t 02maxopen.t 03append.t 04twoarg.t 05override.t
06export.t 07noimport.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: 07noimport.t ---
#!./perl -w
BEGIN {
chdir 't';
@INC = '../lib';
}
require './test.pl';
plan( tests => 1 );
# Try using FileCache without importing to make sure everything's
# initialized without it.
{
package Y;
use FileCache ();
my $file = 'foo';
END { unlink $file }
FileCache::cacheout($file);
print $file "bar";
close $file;
FileCache::cacheout("<", $file);
::ok( <$file> eq "bar" );
close $file;
}
--- NEW FILE: 02maxopen.t ---
#!./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{
1 while 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 );
}
--- NEW FILE: 04twoarg.t ---
#!./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";
close foo;
}
--- NEW FILE: 05override.t ---
#!./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";
}
--- NEW FILE: 06export.t ---
#!./perl
BEGIN {
chdir 't' if -d 't';
#For tests within the perl distribution
@INC = '../lib' if -d '../lib';
END;
# Functions exported by FileCache;
@funcs = qw[cacheout cacheout_close];
$i = 0;
# number of tests
print "1..8\n";
}
# Test 6: Test that exporting both works to package main and
# other packages. Now using Exporter.
# First, we shouldn't be able to have these in our namespace
# Add them to BEGIN so the later 'use' doesn't influence this
# test
BEGIN {
for my $f (@funcs) {
++$i;
print 'not ' if __PACKAGE__->can($f);
print "ok $i\n";
}
}
# With an empty import list, we also shouldn't have them in
# our namespace.
# Add them to BEGIN so the later 'use' doesn't influence this
# test
BEGIN {
use FileCache ();
for my $f (@funcs) {
++$i;
print 'not ' if __PACKAGE__->can($f);
print "ok $i\n";
}
}
# Now, we use FileCache in 'main'
{ use FileCache;
for my $f (@funcs) {
++$i;
print 'not ' if !__PACKAGE__->can($f);
print "ok $i\n";
}
}
# Now we use them in another package
{ package X;
use FileCache;
for my $f (@main::funcs) {
++$main::i;
print 'not ' if !__PACKAGE__->can($f);
print "ok $main::i\n";
}
}
--- NEW FILE: 03append.t ---
#!./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{
1 while 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";
}
--- NEW FILE: 01open.t ---
#!./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{
1 while unlink @files;
}
print "1..1\n";
{# Test 1: that we can open files
for my $path ( @files ){
cacheout $path;
print $path "$path 1\n";
close $path;
}
print "not " unless scalar map({ -f } @files) == scalar @files;
print "ok 1\n";
}
More information about the dslinux-commit
mailing list