1#!perl -w 2# $Id$ 3 4use strict; 5use Test::More tests => 43; 6 7my $class; 8my @tests = qw( t/File-Find-Rule.t t/findrule.t ); 9BEGIN { 10 $class = 'File::Find::Rule'; 11 use_ok($class) 12} 13 14# on win32 systems the t/foobar file isn't 10 bytes it's 11, so the 15# previous tests on the magic number 10 failed. rt.cpan.org #3838 16my $foobar_size = -s 't/foobar'; 17 18my $f = $class->new; 19isa_ok($f, $class); 20 21 22# name 23$f = $class->name( qr/\.t$/ ); 24is_deeply( [ sort $f->in('t') ], 25 [ @tests ], 26 "name( qr/\\.t\$/ )" ); 27 28$f = $class->name( 'foobar' ); 29is_deeply( [ $f->in('t') ], 30 [ 't/foobar' ], 31 "name( 'foobar' )" ); 32 33$f = $class->name( '*.t' ); 34is_deeply( [ sort $f->in('t') ], 35 \@tests, 36 "name( '*.t' )" ); 37 38$f = $class->name( 'foobar', '*.t' ); 39is_deeply( [ sort $f->in('t') ], 40 [ @tests, 't/foobar' ], 41 "name( 'foobar', '*.t' )" ); 42 43$f = $class->name( [ 'foobar', '*.t' ] ); 44is_deeply( [ sort $f->in('t') ], 45 [ @tests, 't/foobar' ], 46 "name( [ 'foobar', '*.t' ] )" ); 47 48 49 50# exec 51$f = $class->exec(sub { length == 6 })->maxdepth(1); 52is_deeply( [ $f->in('t') ], 53 [ 't/foobar' ], 54 "exec (short)" ); 55 56$f = $class->exec(sub { length > $foobar_size })->maxdepth(1); 57is_deeply( [ $f->in('t') ], 58 [ 't/File-Find-Rule.t' ], 59 "exec (long)" ); 60 61is_deeply( [ find( maxdepth => 1, exec => sub { $_[2] eq 't/foobar' }, in => 't' ) ], 62 [ 't/foobar' ], 63 "exec (check arg 2)" ); 64 65# name and exec, chained 66$f = $class 67 ->exec(sub { length > $foobar_size }) 68 ->name( qr/\.t$/ ); 69 70is_deeply( [ $f->in('t') ], 71 [ 't/File-Find-Rule.t' ], 72 "exec(match) and name(match)" ); 73 74$f = $class 75 ->exec(sub { length > $foobar_size }) 76 ->name( qr/foo/ ) 77 ->maxdepth(1); 78 79is_deeply( [ $f->in('t') ], 80 [ ], 81 "exec(match) and name(fail)" ); 82 83 84# directory 85$f = $class 86 ->directory 87 ->maxdepth(1) 88 ->exec(sub { $_ !~ /(\.svn|CVS)/ }); # ignore .svn/CVS dirs 89 90is_deeply( [ $f->in('t') ], 91 [ qw( t t/lib ) ], 92 "directory autostub" ); 93 94 95# any/or 96$f = $class->any( $class->exec( sub { length == 6 } ), 97 $class->name( qr/\.t$/ ) 98 ->exec( sub { length > $foobar_size } ) 99 )->maxdepth(1); 100 101is_deeply( [ sort $f->in('t') ], 102 [ 't/File-Find-Rule.t', 't/foobar' ], 103 "any" ); 104 105$f = $class->or( $class->exec( sub { length == 6 } ), 106 $class->name( qr/\.t$/ ) 107 ->exec( sub { length > $foobar_size } ) 108 )->maxdepth(1); 109 110is_deeply( [ sort $f->in('t') ], 111 [ 't/File-Find-Rule.t', 't/foobar' ], 112 "or" ); 113 114 115# not/none 116$f = $class 117 ->file 118 ->not( $class->name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) ) 119 ->maxdepth(1) 120 ->exec(sub { length == 6 || length > 10 }); 121is_deeply( [ $f->in('t') ], 122 [ 't/File-Find-Rule.t' ], 123 "not" ); 124 125# not as not_* 126$f = $class 127 ->file 128 ->not_name( qr/^[^.]{1,8}(\.[^.]{0,3})?$/ ) 129 ->maxdepth(1) 130 ->exec(sub { length == 6 || length > 10 }); 131is_deeply( [ $f->in('t') ], 132 [ 't/File-Find-Rule.t' ], 133 "not_*" ); 134 135# prune/discard (.svn demo) 136# this test may be a little meaningless for a cpan release, but it 137# fires perfectly in my dev sandbox 138$f = $class->or( $class->directory 139 ->name(qr/(\.svn|CVS)/) 140 ->prune 141 ->discard, 142 $class->new->file ); 143 144is_deeply( [ sort $f->in('t') ], 145 [ @tests, 't/foobar', 't/lib/File/Find/Rule/Test/ATeam.pm' ], 146 "prune/discard .svn" 147 ); 148 149 150# procedural form of the CVS demo 151$f = find(or => [ find( directory => 152 name => qr/(\.svn|CVS)/, 153 prune => 154 discard => ), 155 find( file => ) ]); 156 157is_deeply( [ sort $f->in('t') ], 158 [ @tests, 't/foobar', 't/lib/File/Find/Rule/Test/ATeam.pm' ], 159 "procedural prune/discard .svn" 160 ); 161 162# size (stat test) 163is_deeply( [ find( maxdepth => 1, file => size => $foobar_size, in => 't' ) ], 164 [ 't/foobar' ], 165 "size $foobar_size (stat)" ); 166 167is_deeply( [ find( maxdepth => 1, file => size => "<= $foobar_size", 168 in => 't' ) ], 169 [ 't/foobar' ], 170 "size <= $foobar_size (stat)" ); 171 172is_deeply( [ find( maxdepth => 1, file => size => "<".($foobar_size + 1), 173 in => 't' ) ], 174 [ 't/foobar' ], 175 "size <($foobar_size + 1) (stat)" ); 176 177is_deeply( [ find( maxdepth => 1, file => size => "<1K", 178 exec => sub { length == 6 }, 179 in => 't' ) ], 180 [ 't/foobar' ], 181 "size <1K (stat)" ); 182 183is_deeply( [ find( maxdepth => 1, file => size => ">3K", in => 't' ) ], 184 [ 't/File-Find-Rule.t' ], 185 "size >3K (stat)" ); 186 187# these next two should never fail. if they do then the testing fairy 188# went mad 189is_deeply( [ find( file => size => ">3M", in => 't' ) ], 190 [ ], 191 "size >3M (stat)" ); 192 193is_deeply( [ find( file => size => ">3G", in => 't' ) ], 194 [ ], 195 "size >3G (stat)" ); 196 197 198#min/maxdepth 199 200is_deeply( [ find( maxdepth => 0, in => 't' ) ], 201 [ 't' ], 202 "maxdepth == 0" ); 203 204 205 206my $rule = find( or => [ find( name => qr/(\.svn|CVS)/, 207 discard =>), 208 find(), 209 ], 210 maxdepth => 1 ); 211 212is_deeply( [ sort $rule->in( 't' ) ], 213 [ 't', @tests, 't/foobar', 't/lib' ], 214 "maxdepth == 1" ); 215is_deeply( [ sort $rule->in( 't/' ) ], 216 [ 't', @tests, 't/foobar', 't/lib' ], 217 "maxdepth == 1, trailing slash on the path" ); 218 219is_deeply( [ sort $rule->in( './t' ) ], 220 [ 't', @tests, 't/foobar', 't/lib' ], 221 "maxdepth == 1, ./t" ); 222 223is_deeply( [ sort $rule->in( './/t' ) ], 224 [ 't', @tests, 't/foobar', 't/lib' ], 225 "maxdepth == 1, .//t" ); 226 227is_deeply( [ sort $rule->in( './//t' ) ], 228 [ 't', @tests, 't/foobar', 't/lib' ], 229 "maxdepth == 1, .///t" ); 230 231is_deeply( [ sort $rule->in( './././///./t' ) ], 232 [ 't', @tests, 't/foobar', 't/lib' ], 233 "maxdepth == 1, ./././///./t" ); 234 235my @ateam_path = qw( t/lib 236 t/lib/File 237 t/lib/File/Find 238 t/lib/File/Find/Rule 239 t/lib/File/Find/Rule/Test 240 t/lib/File/Find/Rule/Test/ATeam.pm ); 241 242is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/, 243 prune => 244 discard =>), 245 find( ), 246 ], 247 mindepth => 1, 248 in => 't' ) ], 249 [ @tests, 't/foobar', @ateam_path ], 250 "mindepth == 1" ); 251 252 253is_deeply( [ sort +find( or => [ find( name => qr/(\.svn|CVS)/, 254 discard =>), 255 find(), 256 ], 257 maxdepth => 1, 258 mindepth => 1, 259 in => 't' ) ], 260 [ @tests, 't/foobar', 't/lib' ], 261 "maxdepth = 1 mindepth == 1" ); 262 263# extras 264my $ok = 0; 265find( extras => { preprocess => sub { $ok = 1 } }, in => 't' ); 266ok( $ok, "extras preprocess fired" ); 267 268#iterator 269$f = find( or => [ find( name => qr/(\.svn|CVS)/, 270 prune => 271 discard =>), 272 find(), 273 ], 274 start => 't' ); 275 276{ 277my @found; 278while ($_ = $f->match) { push @found, $_ } 279is_deeply( [ sort @found ], [ 't', @tests, 't/foobar', @ateam_path ], "iterator" ); 280} 281 282# negating in the procedural interface 283is_deeply( [ find( file => '!name' => qr/^[^.]{1,8}(\.[^.]{0,3})?$/, 284 maxdepth => 1, 285 in => 't' ) ], 286 [ 't/File-Find-Rule.t' ], 287 "negating in the procedural interface" ); 288 289# grep 290is_deeply( [ find( maxdepth => 1, file => grep => [ qr/bytes./, [ qr/.?/ ] ], in => 't' ) ], 291 [ 't/foobar' ], 292 "grep" ); 293 294 295 296# relative 297is_deeply( [ find( 'relative', maxdepth => 1, name => 'foobar', in => 't' ) ], 298 [ 'foobar' ], 299 'relative' ); 300 301 302 303# bootstrapping extensions via import 304 305use lib qw(t/lib); 306 307eval { $class->import(':Test::Elusive') }; 308like( $@, qr/^couldn't bootstrap File::Find::Rule::Test::Elusive/, 309 "couldn't find the Elusive extension" ); 310 311eval { $class->import(':Test::ATeam') }; 312is ($@, "", "if you can find them, maybe you can hire the A-Team" ); 313can_ok( $class, 'ba' ); 314