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