|
Packit |
26bf30 |
#!perl -w
|
|
Packit |
26bf30 |
# $Id: /mirror/lab/perl/File-Find-Rule/t/File-Find-Rule.t 2100 2006-05-28T16:06:50.725367Z richardc $
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
use strict;
|
|
Packit |
26bf30 |
use Test::More tests => 41;
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
my $class;
|
|
Packit |
26bf30 |
my @tests = qw( t/File-Find-Rule.t t/findorule.t );
|
|
Packit |
26bf30 |
BEGIN {
|
|
Packit |
26bf30 |
$class = 'File::Find::Object::Rule';
|
|
Packit |
26bf30 |
use_ok($class)
|
|
Packit |
26bf30 |
}
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# on win32 systems the t/foobar file isn't 10 bytes it's 11, so the
|
|
Packit |
26bf30 |
# previous tests on the magic number 10 failed. rt.cpan.org #3838
|
|
Packit |
26bf30 |
my $foobar_size = -s 't/foobar';
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
my $f = $class->new;
|
|
Packit |
26bf30 |
isa_ok($f, $class);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# name
|
|
Packit |
26bf30 |
$f = $class->name( qr/\.t$/ );
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ @tests ],
|
|
Packit |
26bf30 |
"name( qr/\\.t\$/ )" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class->name( 'foobar' );
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"name( 'foobar' )" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class->name( '*.t' );
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
\@tests,
|
|
Packit |
26bf30 |
"name( '*.t' )" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class->name( 'foobar', '*.t' );
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ @tests, 't/foobar' ],
|
|
Packit |
26bf30 |
"name( 'foobar', '*.t' )" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class->name( [ 'foobar', '*.t' ] );
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ @tests, 't/foobar' ],
|
|
Packit |
26bf30 |
"name( [ 'foobar', '*.t' ] )" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# exec
|
|
Packit |
26bf30 |
$f = $class->exec(sub { length($_[0]) == 6 })->maxdepth(1);
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"exec (short)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class->exec(sub { length($_[0]) > $foobar_size })->maxdepth(1);
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t' ],
|
|
Packit |
26bf30 |
"exec (long)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq 't/foobar' }, in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"exec (check arg 2)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# name and exec, chained
|
|
Packit |
26bf30 |
$f = $class
|
|
Packit |
26bf30 |
->exec(sub { length > $foobar_size })
|
|
Packit |
26bf30 |
->name( qr/\.t$/ );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t' ],
|
|
Packit |
26bf30 |
"exec(match) and name(match)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class
|
|
Packit |
26bf30 |
->exec(sub { length > $foobar_size })
|
|
Packit |
26bf30 |
->name( qr/foo/ )
|
|
Packit |
26bf30 |
->maxdepth(1);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ ],
|
|
Packit |
26bf30 |
"exec(match) and name(fail)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# directory
|
|
Packit |
26bf30 |
$f = $class
|
|
Packit |
26bf30 |
->directory
|
|
Packit |
26bf30 |
->maxdepth(1)
|
|
Packit |
26bf30 |
->exec(sub { $_ !~ /(\.svn|CVS)/ }); # ignore .svn/CVS dirs
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ qw( t t/lib ) ],
|
|
Packit |
26bf30 |
"directory autostub" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# any/or
|
|
Packit |
26bf30 |
$f = $class->any( $class->exec( sub { length == 6 } ),
|
|
Packit |
26bf30 |
$class->name( qr/\.t$/ )
|
|
Packit |
26bf30 |
->exec( sub { length > $foobar_size } )
|
|
Packit |
26bf30 |
)->maxdepth(1);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t', 't/foobar' ],
|
|
Packit |
26bf30 |
"any" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
$f = $class->or( $class->exec( sub { length == 6 } ),
|
|
Packit |
26bf30 |
$class->name( qr/\.t$/ )
|
|
Packit |
26bf30 |
->exec( sub { length > $foobar_size } )
|
|
Packit |
26bf30 |
)->maxdepth(1);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t', 't/foobar' ],
|
|
Packit |
26bf30 |
"or" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# not/none
|
|
Packit |
26bf30 |
$f = $class
|
|
Packit |
26bf30 |
->file
|
|
Packit |
26bf30 |
->not( $class->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) )
|
|
Packit |
26bf30 |
->maxdepth(1)
|
|
Packit |
26bf30 |
->exec(sub { length == 6 || length > 11 });
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t' ],
|
|
Packit |
26bf30 |
"not" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# not as not_*
|
|
Packit |
26bf30 |
$f = $class
|
|
Packit |
26bf30 |
->file
|
|
Packit |
26bf30 |
->not_name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ )
|
|
Packit |
26bf30 |
->maxdepth(1)
|
|
Packit |
26bf30 |
->exec(sub { length == 6 || length > 11 });
|
|
Packit |
26bf30 |
is_deeply( [ $f->in('t') ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t' ],
|
|
Packit |
26bf30 |
"not_*" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# prune/discard (.svn demo)
|
|
Packit |
26bf30 |
# this test may be a little meaningless for a cpan release, but it
|
|
Packit |
26bf30 |
# fires perfectly in my dev sandbox
|
|
Packit |
26bf30 |
$f = $class->or( $class->directory
|
|
Packit |
26bf30 |
->name(qr/(\.svn|CVS)/)
|
|
Packit |
26bf30 |
->prune
|
|
Packit |
26bf30 |
->discard,
|
|
Packit |
26bf30 |
$class->new->file );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ @tests, 't/foobar', 't/lib/File/Find/Object/Rule/Test/ATeam.pm' ],
|
|
Packit |
26bf30 |
"prune/discard .svn"
|
|
Packit |
26bf30 |
);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# procedural form of the CVS demo
|
|
Packit |
26bf30 |
$f = find(or => [ find( directory =>
|
|
Packit |
26bf30 |
name => qr/(\.svn|CVS)/,
|
|
Packit |
26bf30 |
prune =>
|
|
Packit |
26bf30 |
discard => ),
|
|
Packit |
26bf30 |
find( file => ) ]);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort $f->in('t') ],
|
|
Packit |
26bf30 |
[ @tests, 't/foobar', 't/lib/File/Find/Object/Rule/Test/ATeam.pm' ],
|
|
Packit |
26bf30 |
"procedural prune/discard .svn"
|
|
Packit |
26bf30 |
);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# size (stat test)
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"size $foobar_size (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, file => size => "<= $foobar_size",
|
|
Packit |
26bf30 |
in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"size <= $foobar_size (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, file => size => "<".($foobar_size + 1),
|
|
Packit |
26bf30 |
in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"size <($foobar_size + 1) (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, file => size => "<1K",
|
|
Packit |
26bf30 |
exec => sub { length == 6 },
|
|
Packit |
26bf30 |
in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"size <1K (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t' ],
|
|
Packit |
26bf30 |
"size >3K (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# these next two should never fail. if they do then the testing fairy
|
|
Packit |
26bf30 |
# went mad
|
|
Packit |
26bf30 |
is_deeply( [ find( file => size => ">3M", in => 't' ) ],
|
|
Packit |
26bf30 |
[ ],
|
|
Packit |
26bf30 |
"size >3M (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( file => size => ">3G", in => 't' ) ],
|
|
Packit |
26bf30 |
[ ],
|
|
Packit |
26bf30 |
"size >3G (stat)" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
#min/maxdepth
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 0, in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't' ],
|
|
Packit |
26bf30 |
"maxdepth == 0" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
my $rule = find( or => [ find( name => qr/(\.svn|CVS)/,
|
|
Packit |
26bf30 |
discard =>),
|
|
Packit |
26bf30 |
find(),
|
|
Packit |
26bf30 |
],
|
|
Packit |
26bf30 |
maxdepth => 1 );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort $rule->in( 't' ) ],
|
|
Packit |
26bf30 |
[ 't', @tests, 't/foobar', 't/lib' ],
|
|
Packit |
26bf30 |
"maxdepth == 1" );
|
|
Packit |
26bf30 |
is_deeply( [ sort $rule->in( 't/' ) ],
|
|
Packit |
26bf30 |
[ 't', @tests, 't/foobar', 't/lib' ],
|
|
Packit |
26bf30 |
"maxdepth == 1, trailing slash on the path" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort $rule->in( './t' ) ],
|
|
Packit |
26bf30 |
[ 't', @tests, 't/foobar', 't/lib' ],
|
|
Packit |
26bf30 |
"maxdepth == 1, ./t" );
|
|
Packit |
26bf30 |
is_deeply( [ sort $rule->in( './././///./t' ) ],
|
|
Packit |
26bf30 |
[ 't', @tests, 't/foobar', 't/lib' ],
|
|
Packit |
26bf30 |
"maxdepth == 1, ./././///./t" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
my @ateam_path = qw( t/lib
|
|
Packit |
26bf30 |
t/lib/File
|
|
Packit |
26bf30 |
t/lib/File/Find
|
|
Packit |
26bf30 |
t/lib/File/Find/Object
|
|
Packit |
26bf30 |
t/lib/File/Find/Object/Rule
|
|
Packit |
26bf30 |
t/lib/File/Find/Object/Rule/Test
|
|
Packit |
26bf30 |
t/lib/File/Find/Object/Rule/Test/ATeam.pm );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
|
|
Packit |
26bf30 |
prune =>
|
|
Packit |
26bf30 |
discard =>),
|
|
Packit |
26bf30 |
find( ),
|
|
Packit |
26bf30 |
],
|
|
Packit |
26bf30 |
mindepth => 1,
|
|
Packit |
26bf30 |
in => 't' ) ],
|
|
Packit |
26bf30 |
[ @tests, 't/foobar', @ateam_path ],
|
|
Packit |
26bf30 |
"mindepth == 1" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/,
|
|
Packit |
26bf30 |
discard =>),
|
|
Packit |
26bf30 |
find(),
|
|
Packit |
26bf30 |
],
|
|
Packit |
26bf30 |
maxdepth => 1,
|
|
Packit |
26bf30 |
mindepth => 1,
|
|
Packit |
26bf30 |
in => 't' ) ],
|
|
Packit |
26bf30 |
[ @tests, 't/foobar', 't/lib' ],
|
|
Packit |
26bf30 |
"maxdepth = 1 mindepth == 1" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# extras
|
|
Packit |
26bf30 |
my $ok = 0;
|
|
Packit |
26bf30 |
find( extras => { preprocess => sub { my ($self, $list) = @_; $ok = 1; return $list; } }, in => 't' );
|
|
Packit |
26bf30 |
ok( $ok, "extras preprocess fired" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
#iterator
|
|
Packit |
26bf30 |
$f = find( or => [ find( name => qr/(\.svn|CVS)/,
|
|
Packit |
26bf30 |
prune =>
|
|
Packit |
26bf30 |
discard =>),
|
|
Packit |
26bf30 |
find(),
|
|
Packit |
26bf30 |
],
|
|
Packit |
26bf30 |
start => 't' );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
{
|
|
Packit |
26bf30 |
my @found;
|
|
Packit |
26bf30 |
while ($_ = $f->match) { push @found, $_ }
|
|
Packit |
26bf30 |
is_deeply( [ sort @found ], [ 't', @tests, 't/foobar', @ateam_path ], "iterator" );
|
|
Packit |
26bf30 |
}
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# negating in the procedural interface
|
|
Packit |
26bf30 |
is_deeply( [ find( file => '!name' => qr/^[^.]{1,9}(\.[^.]{0,3})?$/,
|
|
Packit |
26bf30 |
maxdepth => 1,
|
|
Packit |
26bf30 |
in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/File-Find-Rule.t' ],
|
|
Packit |
26bf30 |
"negating in the procedural interface" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# grep
|
|
Packit |
26bf30 |
is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => 't' ) ],
|
|
Packit |
26bf30 |
[ 't/foobar' ],
|
|
Packit |
26bf30 |
"grep" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# relative
|
|
Packit |
26bf30 |
is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => 't' ) ],
|
|
Packit |
26bf30 |
[ 'foobar' ],
|
|
Packit |
26bf30 |
'relative' );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
# bootstrapping extensions via import
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
use lib qw(t/lib);
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
eval { $class->import(':Test::Elusive') };
|
|
Packit |
26bf30 |
like( $@, qr/^couldn't bootstrap File::Find::Object::Rule::Test::Elusive/,
|
|
Packit |
26bf30 |
"couldn't find the Elusive extension" );
|
|
Packit |
26bf30 |
|
|
Packit |
26bf30 |
eval { $class->import(':Test::ATeam') };
|
|
Packit |
26bf30 |
is ($@, "", "if you can find them, maybe you can hire the A-Team" );
|
|
Packit |
26bf30 |
can_ok( $class, 'ba' );
|