1#!./perl 2use strict; 3use Cwd; 4 5my $warn_msg; 6 7BEGIN { 8 require File::Spec; 9 if ($ENV{PERL_CORE}) { 10 # May be doing dynamic loading while @INC is all relative 11 @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC; 12 } 13 $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }; 14 15 if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') { 16 # This is a hack - at present File::Find does not produce native names 17 # on Win32 or VMS, so force File::Spec to use Unix names. 18 # must be set *before* importing File::Find 19 require File::Spec::Unix; 20 @File::Spec::ISA = 'File::Spec::Unix'; 21 } 22 require File::Find; 23 import File::Find; 24} 25 26my $symlink_exists = eval { symlink("",""); 1 }; 27my $test_count = 111; 28$test_count += 127 if $symlink_exists; 29$test_count += 26 if $^O eq 'MSWin32'; 30$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists; 31 32use Test::More; 33plan tests => $test_count; 34use lib qw( ./t/lib ); 35use Testing qw( 36 create_file_ok 37 mkdir_ok 38 symlink_ok 39 dir_path 40 file_path 41); 42 43my %Expect_File = (); # what we expect for $_ 44my %Expect_Name = (); # what we expect for $File::Find::name/fullname 45my %Expect_Dir = (); # what we expect for $File::Find::dir 46my (@files); 47 48my $orig_dir = cwd(); 49 50# Uncomment this to see where File::Find is chdir-ing to. Helpful for 51# debugging its little jaunts around the filesystem. 52# BEGIN { 53# use Cwd; 54# *CORE::GLOBAL::chdir = sub ($) { 55# my($file, $line) = (caller)[1,2]; 56# 57# printf "# cwd: %s\n", cwd(); 58# print "# chdir: @_ from $file at $line\n"; 59# my($return) = CORE::chdir($_[0]); 60# printf "# newcwd: %s\n", cwd(); 61# 62# return $return; 63# }; 64# } 65 66cleanup(); 67 68##### Sanity checks ##### 69# Do find() and finddepth() work correctly with an empty list of 70# directories? 71{ 72 ok(eval { find(\&noop_wanted); 1 }, 73 "'find' successfully returned for an empty list of directories"); 74 75 ok(eval { finddepth(\&noop_wanted); 1 }, 76 "'finddepth' successfully returned for an empty list of directories"); 77} 78 79# Do find() and finddepth() work correctly in the directory 80# from which we start? (Test presumes the presence of 'taint.t' in same 81# directory as this test file.) 82 83$::count_taint = 0; 84find({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } }, 85 File::Spec->curdir); 86is($::count_taint, 1, "'find' found exactly 1 file named 'taint.t'"); 87 88$::count_taint = 0; 89finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } }, 90 File::Spec->curdir); 91is($::count_taint, 1, "'finddepth' found exactly 1 file named 'taint.t'"); 92 93##### RT #122547 ##### 94# Do find() and finddepth() correctly warn on invalid options? 95{ 96 my $bad_option = 'foobar'; 97 my $second_bad_option = 'really_foobar'; 98 99 $::count_taint = 0; 100 local $SIG{__WARN__} = sub { $warn_msg = $_[0]; }; 101 { 102 find( 103 { 104 wanted => sub { ++$::count_taint if $_ eq 'taint.t'; }, 105 $bad_option => undef, 106 }, 107 File::Spec->curdir 108 ); 109 }; 110 like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); 111 like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); 112 is($::count_taint, 1, "count_taint incremented"); 113 undef $warn_msg; 114 115 $::count_taint = 0; 116 { 117 finddepth( 118 { 119 wanted => sub { ++$::count_taint if $_ eq 'taint.t'; }, 120 $bad_option => undef, 121 $second_bad_option => undef, 122 }, 123 File::Spec->curdir 124 ); 125 }; 126 like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); 127 like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); 128 like($warn_msg, qr/$second_bad_option/s, "Got warning for $second_bad_option"); 129 is($::count_taint, 1, "count_taint incremented"); 130 undef $warn_msg; 131} 132 133my $FastFileTests_OK = 0; 134 135sub cleanup { 136 chdir($orig_dir); 137 my $need_updir = 0; 138 if (-d dir_path('for_find')) { 139 $need_updir = 1 if chdir(dir_path('for_find')); 140 } 141 if (-d dir_path('fa')) { 142 unlink file_path('fa', 'fa_ord'), 143 file_path('fa', 'fsl'), 144 file_path('fa', 'faa', 'faa_ord'), 145 file_path('fa', 'fab', 'fab_ord'), 146 file_path('fa', 'fab', 'faba', 'faba_ord'), 147 file_path('fa', 'fac', 'faca'), 148 file_path('fb', 'fb_ord'), 149 file_path('fb', 'fba', 'fba_ord'), 150 file_path('fb', 'fbc', 'fbca'), 151 file_path('fa', 'fax', 'faz'), 152 file_path('fa', 'fay'); 153 rmdir dir_path('fa', 'faa'); 154 rmdir dir_path('fa', 'fab', 'faba'); 155 rmdir dir_path('fa', 'fab'); 156 rmdir dir_path('fa', 'fac'); 157 rmdir dir_path('fa', 'fax'); 158 rmdir dir_path('fa'); 159 rmdir dir_path('fb', 'fba'); 160 rmdir dir_path('fb', 'fbc'); 161 rmdir dir_path('fb'); 162 } 163 if (-d dir_path('fc')) { 164 unlink ( 165 file_path('fc', 'fca', 'match_alpha'), 166 file_path('fc', 'fca', 'match_beta'), 167 file_path('fc', 'fcb', 'match_gamma'), 168 file_path('fc', 'fcb', 'delta'), 169 file_path('fc', 'fcc', 'match_epsilon'), 170 file_path('fc', 'fcc', 'match_zeta'), 171 file_path('fc', 'fcc', 'eta'), 172 ); 173 rmdir dir_path('fc', 'fca'); 174 rmdir dir_path('fc', 'fcb'); 175 rmdir dir_path('fc', 'fcc'); 176 rmdir dir_path('fc'); 177 } 178 if ($need_updir) { 179 my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir; 180 chdir($updir); 181 } 182 if (-d dir_path('for_find')) { 183 rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n"; 184 } 185} 186 187END { 188 cleanup(); 189} 190 191sub wanted_File_Dir { 192 print "# \$File::Find::dir => '$File::Find::dir'\t\$_ => '$_'\n"; 193 s#\.$## if ($^O eq 'VMS' && $_ ne '.'); # 194 s/(.dir)?$//i if ($^O eq 'VMS' && -d _); 195 ok( $Expect_File{$_}, "found $_ for \$_, as expected" ); 196 if ( $FastFileTests_OK ) { 197 delete $Expect_File{$_} 198 unless ( $Expect_Dir{$_} && ! -d _ ); 199 } 200 else { 201 delete $Expect_File{$_} 202 unless ( $Expect_Dir{$_} && ! -d $_ ); 203 } 204} 205 206sub wanted_File_Dir_prune { 207 &wanted_File_Dir; 208 $File::Find::prune = 1 if $_ eq 'faba'; 209} 210 211sub wanted_Name { 212 my $n = $File::Find::name; 213 $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.'); # 214 print "# \$File::Find::name => '$n'\n"; 215 my $i = rindex($n,'/'); 216 my $OK = exists($Expect_Name{$n}); 217 if ( $OK ) { 218 $OK= exists($Expect_Name{substr($n,0,$i)}) if $i >= 0; 219 } 220 ok( $OK, "found $n for \$File::Find::name, as expected" ); 221 delete $Expect_Name{$n}; 222} 223 224sub wanted_File { 225 print "# \$_ => '$_'\n"; 226 s#\.$## if ($^O eq 'VMS' && $_ ne '.'); # 227 my $i = rindex($_,'/'); 228 my $OK = exists($Expect_File{ $_}); 229 if ( $OK ) { 230 $OK= exists($Expect_File{ substr($_,0,$i)}) if $i >= 0; 231 } 232 ok( $OK, "found $_ for \$_, as expected" ); 233 delete $Expect_File{ $_}; 234} 235 236sub simple_wanted { 237 print "# \$File::Find::dir => '$File::Find::dir'\n"; 238 print "# \$_ => '$_'\n"; 239} 240 241sub noop_wanted {} 242 243sub my_preprocess { 244 @files = @_; 245 print "# --preprocess--\n"; 246 print "# \$File::Find::dir => '$File::Find::dir' \n"; 247 foreach my $file (@files) { 248 $file =~ s/\.(dir)?$//i if $^O eq 'VMS'; 249 print "# $file \n"; 250 delete $Expect_Dir{ $File::Find::dir }->{$file}; 251 } 252 print "# --end preprocess--\n"; 253 is(scalar(keys %{$Expect_Dir{ $File::Find::dir }}), 0, 254 "my_preprocess: got 0, as expected"); 255 if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) { 256 delete $Expect_Dir{ $File::Find::dir } 257 } 258 return @files; 259} 260 261sub my_postprocess { 262 print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n"; 263 delete $Expect_Dir{ $File::Find::dir}; 264} 265 266# Use topdir() to specify a directory path that you want to pass to 267# find/finddepth. Historically topdir() differed on Mac OS classic. 268 269*topdir = \&dir_path; 270 271# Use file_path_name() to specify a file path that is expected for 272# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 273# option is in effect, $_ is the same as $File::Find::Name. In that 274# case, also use this function to specify a file path that is expected 275# for $_. 276# 277# Historically file_path_name differed on Mac OS classic. 278 279*file_path_name = \&file_path; 280 281##### Create directories, files and symlinks used in testing ##### 282 283mkdir_ok( dir_path('for_find'), 0770 ); 284ok( chdir( dir_path('for_find')), "Able to chdir to 'for_find'") 285 or die("Unable to chdir to 'for_find'"); 286mkdir_ok( dir_path('fa'), 0770 ); 287mkdir_ok( dir_path('fb'), 0770 ); 288create_file_ok( file_path('fb', 'fb_ord') ); 289mkdir_ok( dir_path('fb', 'fba'), 0770 ); 290create_file_ok( file_path('fb', 'fba', 'fba_ord') ); 291if ($symlink_exists) { 292 symlink_ok('../fb','fa/fsl'); 293} 294create_file_ok( file_path('fa', 'fa_ord') ); 295 296mkdir_ok( dir_path('fa', 'faa'), 0770 ); 297create_file_ok( file_path('fa', 'faa', 'faa_ord') ); 298mkdir_ok( dir_path('fa', 'fab'), 0770 ); 299create_file_ok( file_path('fa', 'fab', 'fab_ord') ); 300mkdir_ok( dir_path('fa', 'fab', 'faba'), 0770 ); 301create_file_ok( file_path('fa', 'fab', 'faba', 'faba_ord') ); 302 303##### Basic tests for find() ##### 304# Set up list of files we expect to find. 305# Run find(), removing a file from the list once we have found it. 306# The list should be empty once we are done. 307 308%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1, 309 file_path('fa_ord') => 1, file_path('fab') => 1, 310 file_path('fab_ord') => 1, file_path('faba') => 1, 311 file_path('faa') => 1, file_path('faa_ord') => 1); 312 313delete $Expect_File{ file_path('fsl') } unless $symlink_exists; 314%Expect_Name = (); 315 316%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, 317 dir_path('fab') => 1, dir_path('faba') => 1, 318 dir_path('fb') => 1, dir_path('fba') => 1); 319 320delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; 321File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') ); 322is( scalar(keys %Expect_File), 0, "COMPLETE: Basic test of find()" ); 323 324##### Re-entrancy ##### 325 326print "# check re-entrancy\n"; 327 328%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1, 329 file_path('fa_ord') => 1, file_path('fab') => 1, 330 file_path('fab_ord') => 1, file_path('faba') => 1, 331 file_path('faa') => 1, file_path('faa_ord') => 1); 332 333delete $Expect_File{ file_path('fsl') } unless $symlink_exists; 334%Expect_Name = (); 335 336%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, 337 dir_path('fab') => 1, dir_path('faba') => 1, 338 dir_path('fb') => 1, dir_path('fba') => 1); 339 340delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; 341 342File::Find::find( {wanted => sub { wanted_File_Dir_prune(); 343 File::Find::find( {wanted => sub 344 {} }, File::Spec->curdir ); } }, 345 topdir('fa') ); 346 347is( scalar(keys %Expect_File), 0, "COMPLETE: Test of find() for re-entrancy" ); 348 349##### 'no_chdir' option ##### 350# no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File 351 352%Expect_File = (file_path_name('fa') => 1, 353 file_path_name('fa', 'fsl') => 1, 354 file_path_name('fa', 'fa_ord') => 1, 355 file_path_name('fa', 'fab') => 1, 356 file_path_name('fa', 'fab', 'fab_ord') => 1, 357 file_path_name('fa', 'fab', 'faba') => 1, 358 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 359 file_path_name('fa', 'faa') => 1, 360 file_path_name('fa', 'faa', 'faa_ord') => 1,); 361 362delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists; 363%Expect_Name = (); 364 365%Expect_Dir = (dir_path('fa') => 1, 366 dir_path('fa', 'faa') => 1, 367 dir_path('fa', 'fab') => 1, 368 dir_path('fa', 'fab', 'faba') => 1, 369 dir_path('fb') => 1, 370 dir_path('fb', 'fba') => 1); 371 372delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') } 373 unless $symlink_exists; 374 375File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, 376 topdir('fa') ); 377is( scalar(keys %Expect_File), 0, "COMPLETE: Test of 'no_chdir' option" ); 378 379##### Test for $File::Find::name ##### 380 381%Expect_File = (); 382 383%Expect_Name = (File::Spec->curdir => 1, 384 file_path_name('.', 'fa') => 1, 385 file_path_name('.', 'fa', 'fsl') => 1, 386 file_path_name('.', 'fa', 'fa_ord') => 1, 387 file_path_name('.', 'fa', 'fab') => 1, 388 file_path_name('.', 'fa', 'fab', 'fab_ord') => 1, 389 file_path_name('.', 'fa', 'fab', 'faba') => 1, 390 file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1, 391 file_path_name('.', 'fa', 'faa') => 1, 392 file_path_name('.', 'fa', 'faa', 'faa_ord') => 1, 393 file_path_name('.', 'fb') => 1, 394 file_path_name('.', 'fb', 'fba') => 1, 395 file_path_name('.', 'fb', 'fba', 'fba_ord') => 1, 396 file_path_name('.', 'fb', 'fb_ord') => 1); 397 398delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists; 399%Expect_Dir = (); 400File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir ); 401is( scalar(keys %Expect_Name), 0, "COMPLETE: Test for \$File::Find::name" ); 402 403 404##### ##### 405# no_chdir is in effect, hence we use file_path_name to specify the 406# expected paths for %Expect_File 407 408%Expect_File = (File::Spec->curdir => 1, 409 file_path_name('.', 'fa') => 1, 410 file_path_name('.', 'fa', 'fsl') => 1, 411 file_path_name('.', 'fa', 'fa_ord') => 1, 412 file_path_name('.', 'fa', 'fab') => 1, 413 file_path_name('.', 'fa', 'fab', 'fab_ord') => 1, 414 file_path_name('.', 'fa', 'fab', 'faba') => 1, 415 file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1, 416 file_path_name('.', 'fa', 'faa') => 1, 417 file_path_name('.', 'fa', 'faa', 'faa_ord') => 1, 418 file_path_name('.', 'fb') => 1, 419 file_path_name('.', 'fb', 'fba') => 1, 420 file_path_name('.', 'fb', 'fba', 'fba_ord') => 1, 421 file_path_name('.', 'fb', 'fb_ord') => 1); 422 423delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists; 424%Expect_Name = (); 425%Expect_Dir = (); 426 427File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1}, 428 File::Spec->curdir ); 429 430is( scalar(keys %Expect_File), 0, 431 "COMPLETE: Equivalency of \$_ and \$File::Find::Name with 'no_chdir'" ); 432 433##### ##### 434 435print "# check preprocess\n"; 436%Expect_File = (); 437%Expect_Name = (); 438%Expect_Dir = ( 439 File::Spec->curdir => {fa => 1, fb => 1}, 440 dir_path('.', 'fa') => {faa => 1, fab => 1, fa_ord => 1}, 441 dir_path('.', 'fa', 'faa') => {faa_ord => 1}, 442 dir_path('.', 'fa', 'fab') => {faba => 1, fab_ord => 1}, 443 dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1}, 444 dir_path('.', 'fb') => {fba => 1, fb_ord => 1}, 445 dir_path('.', 'fb', 'fba') => {fba_ord => 1} 446 ); 447 448File::Find::find( {wanted => \&noop_wanted, 449 preprocess => \&my_preprocess}, File::Spec->curdir ); 450 451is( scalar(keys %Expect_Dir), 0, "Got no files, as expected" ); 452 453##### ##### 454 455print "# check postprocess\n"; 456%Expect_File = (); 457%Expect_Name = (); 458%Expect_Dir = ( 459 File::Spec->curdir => 1, 460 dir_path('.', 'fa') => 1, 461 dir_path('.', 'fa', 'faa') => 1, 462 dir_path('.', 'fa', 'fab') => 1, 463 dir_path('.', 'fa', 'fab', 'faba') => 1, 464 dir_path('.', 'fb') => 1, 465 dir_path('.', 'fb', 'fba') => 1 466 ); 467 468File::Find::find( {wanted => \&noop_wanted, 469 postprocess => \&my_postprocess}, File::Spec->curdir ); 470 471is( scalar(keys %Expect_Dir), 0, "Got no files, as expected" ); 472 473##### ##### 474{ 475 print "# checking argument localization\n"; 476 477 ### this checks the fix of perlbug [19977] ### 478 my @foo = qw( a b c d e f ); 479 my %pre = map { $_ => } @foo; 480 481 File::Find::find( sub { } , 'fa' ) for @foo; 482 delete $pre{$_} for @foo; 483 484 is( scalar(keys %pre), 0, "Got no files, as expected" ); 485} 486 487##### ##### 488# see thread starting 489# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-02/msg00351.html 490{ 491 print "# checking that &_ and %_ are still accessible and that\n", 492 "# tie magic on \$_ is not triggered\n"; 493 494 my $true_count; 495 my $sub = 0; 496 sub _ { 497 ++$sub; 498 } 499 my $tie_called = 0; 500 501 package Foo; 502 sub STORE { 503 ++$tie_called; 504 } 505 sub FETCH {return 'N'}; 506 sub TIESCALAR {bless []}; 507 package main; 508 509 is( scalar(keys %_), 0, "Got no files, as expected" ); 510 my @foo = 'n'; 511 tie $foo[0], "Foo"; 512 513 File::Find::find( sub { $true_count++; $_{$_}++; &_; } , 'fa' ) for @foo; 514 untie $_; 515 516 is( $tie_called, 0, "Got no files tie_called, as expected" ); 517 is( scalar(keys %_), $true_count, "Got true count, as expected" ); 518 is( $sub, $true_count, "Got true count, as expected" ); 519 is( scalar( @foo), 1, "Got one file, as expected" ); 520 is( $foo[0], 'N', "Got 'N', as expected" ); 521} 522 523##### ##### 524if ( $symlink_exists ) { 525 print "# --- symbolic link tests --- \n"; 526 $FastFileTests_OK= 1; 527 528 # 'follow', 'follow_fast' and 'follow_skip' options only apply when a 529 # platform supports symlinks. 530 531 ##### ##### 532 533 # Verify that File::Find::find will call wanted even if the topdir 534 # is a symlink to a directory, and it should not follow the link 535 # unless follow is set, which it is not in this case 536 %Expect_File = ( file_path('fsl') => 1 ); 537 %Expect_Name = (); 538 %Expect_Dir = (); 539 File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') ); 540 is( scalar(keys %Expect_File), 0, 541 "COMPLETE: top dir can be symlink to dir; link not followed without 'follow' option" ); 542 543 ##### ##### 544 545 %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1, 546 file_path('fsl') => 1, file_path('fb_ord') => 1, 547 file_path('fba') => 1, file_path('fba_ord') => 1, 548 file_path('fab') => 1, file_path('fab_ord') => 1, 549 file_path('faba') => 1, file_path('faa') => 1, 550 file_path('faa_ord') => 1); 551 552 %Expect_Name = (); 553 554 %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1, 555 dir_path('faa') => 1, dir_path('fab') => 1, 556 dir_path('faba') => 1, dir_path('fb') => 1, 557 dir_path('fba') => 1); 558 559 File::Find::find( {wanted => \&wanted_File_Dir_prune, 560 follow_fast => 1}, topdir('fa') ); 561 562 is( scalar(keys %Expect_File), 0, 563 "COMPLETE: test of 'follow_fast' option: \$_ case" ); 564 565 ##### ##### 566 567 # no_chdir is in effect, hence we use file_path_name to specify 568 # the expected paths for %Expect_File 569 570 %Expect_File = (file_path_name('fa') => 1, 571 file_path_name('fa', 'fa_ord') => 1, 572 file_path_name('fa', 'fsl') => 1, 573 file_path_name('fa', 'fsl', 'fb_ord') => 1, 574 file_path_name('fa', 'fsl', 'fba') => 1, 575 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, 576 file_path_name('fa', 'fab') => 1, 577 file_path_name('fa', 'fab', 'fab_ord') => 1, 578 file_path_name('fa', 'fab', 'faba') => 1, 579 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 580 file_path_name('fa', 'faa') => 1, 581 file_path_name('fa', 'faa', 'faa_ord') => 1); 582 583 %Expect_Name = (); 584 585 %Expect_Dir = (dir_path('fa') => 1, 586 dir_path('fa', 'faa') => 1, 587 dir_path('fa', 'fab') => 1, 588 dir_path('fa', 'fab', 'faba') => 1, 589 dir_path('fb') => 1, 590 dir_path('fb', 'fba') => 1); 591 592 File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, 593 no_chdir => 1}, topdir('fa') ); 594 595 is( scalar(keys %Expect_File), 0, 596 "COMPLETE: Test of 'follow_fast' and 'no_chdir' options together: \$_ case" ); 597 598 ##### ##### 599 600 %Expect_File = (); 601 602 %Expect_Name = (file_path_name('fa') => 1, 603 file_path_name('fa', 'fa_ord') => 1, 604 file_path_name('fa', 'fsl') => 1, 605 file_path_name('fa', 'fsl', 'fb_ord') => 1, 606 file_path_name('fa', 'fsl', 'fba') => 1, 607 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, 608 file_path_name('fa', 'fab') => 1, 609 file_path_name('fa', 'fab', 'fab_ord') => 1, 610 file_path_name('fa', 'fab', 'faba') => 1, 611 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 612 file_path_name('fa', 'faa') => 1, 613 file_path_name('fa', 'faa', 'faa_ord') => 1); 614 615 %Expect_Dir = (); 616 617 File::Find::finddepth( {wanted => \&wanted_Name, 618 follow_fast => 1}, topdir('fa') ); 619 620 is( scalar(keys %Expect_Name), 0, 621 "COMPLETE: test of 'follow_fast' option: \$File::Find::name case" ); 622 623 ##### ##### 624 625 # no_chdir is in effect, hence we use file_path_name to specify 626 # the expected paths for %Expect_File 627 628 %Expect_File = (file_path_name('fa') => 1, 629 file_path_name('fa', 'fa_ord') => 1, 630 file_path_name('fa', 'fsl') => 1, 631 file_path_name('fa', 'fsl', 'fb_ord') => 1, 632 file_path_name('fa', 'fsl', 'fba') => 1, 633 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, 634 file_path_name('fa', 'fab') => 1, 635 file_path_name('fa', 'fab', 'fab_ord') => 1, 636 file_path_name('fa', 'fab', 'faba') => 1, 637 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 638 file_path_name('fa', 'faa') => 1, 639 file_path_name('fa', 'faa', 'faa_ord') => 1); 640 641 %Expect_Name = (); 642 %Expect_Dir = (); 643 644 File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1, 645 no_chdir => 1}, topdir('fa') ); 646 647 is( scalar(keys %Expect_File), 0, 648 "COMPLETE: Test of 'follow_fast' and 'no_chdir' options together: \$File::Find::name case" ); 649 650 ##### ##### 651 652 print "# check dangling symbolic links\n"; 653 mkdir_ok( dir_path('dangling_dir'), 0770 ); 654 symlink_ok( dir_path('dangling_dir'), file_path('dangling_dir_sl'), 655 "Check dangling directory" ); 656 rmdir dir_path('dangling_dir'); 657 create_file_ok(file_path('dangling_file')); 658 symlink_ok('../dangling_file','fa/dangling_file_sl', 659 "Check dangling file" ); 660 unlink file_path('dangling_file'); 661 662 { 663 # these tests should also emit a warning 664 use warnings; 665 666 %Expect_File = (File::Spec->curdir => 1, 667 file_path('dangling_file_sl') => 1, 668 file_path('fa_ord') => 1, 669 file_path('fsl') => 1, 670 file_path('fb_ord') => 1, 671 file_path('fba') => 1, 672 file_path('fba_ord') => 1, 673 file_path('fab') => 1, 674 file_path('fab_ord') => 1, 675 file_path('faba') => 1, 676 file_path('faba_ord') => 1, 677 file_path('faa') => 1, 678 file_path('faa_ord') => 1); 679 680 %Expect_Name = (); 681 %Expect_Dir = (); 682 undef $warn_msg; 683 684 File::Find::find( {wanted => \&wanted_File, follow => 1, 685 dangling_symlinks => 686 sub { $warn_msg = "$_[0] is a dangling symbolic link" } 687 }, 688 topdir('dangling_dir_sl'), topdir('fa') ); 689 690 is( scalar(keys %Expect_File), 0, 691 "COMPLETE: test of 'follow' and 'dangling_symlinks' options" ); 692 like( $warn_msg, qr/dangling_file_sl is a dangling symbolic link/, 693 "Got expected warning message re dangling symbolic link" ); 694 unlink file_path('fa', 'dangling_file_sl'), 695 file_path('dangling_dir_sl'); 696 697 } 698 699 ##### ##### 700 701 print "# check recursion\n"; 702 symlink_ok('../faa','fa/faa/faa_sl'); 703 undef $@; 704 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, 705 no_chdir => 1}, topdir('fa') ); }; 706 like( 707 $@, 708 qr{for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link}i, 709 "Got expected error message for recursive symbolic link" 710 ); 711 unlink file_path('fa', 'faa', 'faa_sl'); 712 713 714 print "# check follow_skip (file)\n"; 715 symlink_ok('./fa_ord','fa/fa_ord_sl'); 716 undef $@; 717 718 eval {File::Find::finddepth( {wanted => \&simple_wanted, 719 follow => 1, 720 follow_skip => 0, no_chdir => 1}, 721 topdir('fa') );}; 722 723 like( 724 $@, 725 qr{for_find[:/]fa[:/]fa_ord encountered a second time}i, 726 "'follow_skip==0': got error message when file encountered a second time" 727 ); 728 729 ##### ##### 730 731 # no_chdir is in effect, hence we use file_path_name to specify 732 # the expected paths for %Expect_File 733 734 %Expect_File = (file_path_name('fa') => 1, 735 file_path_name('fa', 'fa_ord') => 2, 736 # We may encounter the symlink first 737 file_path_name('fa', 'fa_ord_sl') => 2, 738 file_path_name('fa', 'fsl') => 1, 739 file_path_name('fa', 'fsl', 'fb_ord') => 1, 740 file_path_name('fa', 'fsl', 'fba') => 1, 741 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, 742 file_path_name('fa', 'fab') => 1, 743 file_path_name('fa', 'fab', 'fab_ord') => 1, 744 file_path_name('fa', 'fab', 'faba') => 1, 745 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 746 file_path_name('fa', 'faa') => 1, 747 file_path_name('fa', 'faa', 'faa_ord') => 1); 748 749 %Expect_Name = (); 750 751 %Expect_Dir = (dir_path('fa') => 1, 752 dir_path('fa', 'faa') => 1, 753 dir_path('fa', 'fab') => 1, 754 dir_path('fa', 'fab', 'faba') => 1, 755 dir_path('fb') => 1, 756 dir_path('fb','fba') => 1); 757 758 File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1, 759 follow_skip => 1, no_chdir => 1}, 760 topdir('fa') ); 761 is( scalar(keys %Expect_File), 0, 762 "COMPLETE: Test of 'follow', 'follow_skip==1' and 'no_chdir' options" ); 763 unlink file_path('fa', 'fa_ord_sl'); 764 765 ##### ##### 766 print "# check follow_skip (directory)\n"; 767 symlink_ok('./faa','fa/faa_sl'); 768 undef $@; 769 770 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, 771 follow_skip => 0, no_chdir => 1}, 772 topdir('fa') );}; 773 774 like( 775 $@, 776 qr{for_find[:/]fa[:/]faa[:/]? encountered a second time}i, 777 "'follow_skip==0': got error message when directory encountered a second time" 778 ); 779 780 781 undef $@; 782 783 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, 784 follow_skip => 1, no_chdir => 1}, 785 topdir('fa') );}; 786 787 like( 788 $@, 789 qr{for_find[:/]fa[:/]faa[:/]? encountered a second time}i, 790 "'follow_skip==1': got error message when directory encountered a second time" 791 ); 792 793 ##### ##### 794 795 # no_chdir is in effect, hence we use file_path_name to specify 796 # the expected paths for %Expect_File 797 798 %Expect_File = (file_path_name('fa') => 1, 799 file_path_name('fa', 'fa_ord') => 1, 800 file_path_name('fa', 'fsl') => 1, 801 file_path_name('fa', 'fsl', 'fb_ord') => 1, 802 file_path_name('fa', 'fsl', 'fba') => 1, 803 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, 804 file_path_name('fa', 'fab') => 1, 805 file_path_name('fa', 'fab', 'fab_ord') => 1, 806 file_path_name('fa', 'fab', 'faba') => 1, 807 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 808 file_path_name('fa', 'faa') => 1, 809 file_path_name('fa', 'faa', 'faa_ord') => 1, 810 # We may actually encounter the symlink first. 811 file_path_name('fa', 'faa_sl') => 1, 812 file_path_name('fa', 'faa_sl', 'faa_ord') => 1); 813 814 %Expect_Name = (); 815 816 %Expect_Dir = (dir_path('fa') => 1, 817 dir_path('fa', 'faa') => 1, 818 dir_path('fa', 'fab') => 1, 819 dir_path('fa', 'fab', 'faba') => 1, 820 dir_path('fb') => 1, 821 dir_path('fb', 'fba') => 1); 822 823 File::Find::find( {wanted => \&wanted_File_Dir, follow => 1, 824 follow_skip => 2, no_chdir => 1}, topdir('fa') ); 825 826 ##### ##### 827 828 # If we encountered the symlink first, then the entries corresponding to 829 # the real name remain, if the real name first then the symlink 830 my @names = sort keys %Expect_File; 831 is( scalar(@names), 1, 832 "'follow_skip==2'" ); 833 # Normalise both to the original name 834 s/_sl// foreach @names; 835 is( 836 $names[0], 837 file_path_name('fa', 'faa', 'faa_ord'), 838 "Got file_path_name, as expected" 839 ); 840 unlink file_path('fa', 'faa_sl'); 841 842} 843 844##### Win32 checks - [perl #41555] ##### 845 846if ($^O eq 'MSWin32') { 847 require File::Spec::Win32; 848 my ($volume) = File::Spec::Win32->splitpath($orig_dir, 1); 849 print STDERR "VOLUME = $volume\n"; 850 851 ##### ##### 852 853 # with chdir 854 %Expect_File = (File::Spec->curdir => 1, 855 file_path('fsl') => 1, 856 file_path('fa_ord') => 1, 857 file_path('fab') => 1, 858 file_path('fab_ord') => 1, 859 file_path('faba') => 1, 860 file_path('faba_ord') => 1, 861 file_path('faa') => 1, 862 file_path('faa_ord') => 1); 863 864 delete $Expect_File{ file_path('fsl') } unless $symlink_exists; 865 %Expect_Name = (); 866 867 %Expect_Dir = (dir_path('fa') => 1, 868 dir_path('faa') => 1, 869 dir_path('fab') => 1, 870 dir_path('faba') => 1, 871 dir_path('fb') => 1, 872 dir_path('fba') => 1); 873 874 File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa')); 875 is( scalar(keys %Expect_File), 0, "Got no files, as expected" ); 876 877 ##### ##### 878 879 # no_chdir 880 %Expect_File = ($volume . file_path_name('fa') => 1, 881 $volume . file_path_name('fa', 'fsl') => 1, 882 $volume . file_path_name('fa', 'fa_ord') => 1, 883 $volume . file_path_name('fa', 'fab') => 1, 884 $volume . file_path_name('fa', 'fab', 'fab_ord') => 1, 885 $volume . file_path_name('fa', 'fab', 'faba') => 1, 886 $volume . file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, 887 $volume . file_path_name('fa', 'faa') => 1, 888 $volume . file_path_name('fa', 'faa', 'faa_ord') => 1); 889 890 891 delete $Expect_File{ $volume . file_path_name('fa', 'fsl') } unless $symlink_exists; 892 %Expect_Name = (); 893 894 %Expect_Dir = ($volume . dir_path('fa') => 1, 895 $volume . dir_path('fa', 'faa') => 1, 896 $volume . dir_path('fa', 'fab') => 1, 897 $volume . dir_path('fa', 'fab', 'faba') => 1); 898 899 File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, $volume . topdir('fa')); 900 is( scalar(keys %Expect_File), 0, "Got no files, as expected" ); 901} 902 903 904##### Issue 68260 ##### 905 906if ($symlink_exists) { 907 print "# BUG 68260\n"; 908 mkdir_ok(dir_path ('fa', 'fac'), 0770); 909 mkdir_ok(dir_path ('fb', 'fbc'), 0770); 910 create_file_ok(file_path ('fa', 'fac', 'faca')); 911 symlink_ok('..////../fa/fac/faca', 'fb/fbc/fbca', 912 "RT 68260: able to symlink"); 913 914 use warnings; 915 my $dangling_symlink; 916 local $SIG {__WARN__} = sub { 917 local $" = " "; # " 918 $dangling_symlink ++ if "@_" =~ /dangling symbolic link/; 919 }; 920 921 File::Find::find ( 922 { 923 wanted => sub {1;}, 924 follow => 1, 925 follow_skip => 2, 926 dangling_symlinks => 1, 927 }, 928 File::Spec -> curdir 929 ); 930 931 ok(!$dangling_symlink, "Found no dangling symlink"); 932} 933 934if ($symlink_exists) { # perl #120388 935 print "# BUG 120388\n"; 936 mkdir_ok(dir_path ('fa', 'fax'), 0770); 937 create_file_ok(file_path ('fa', 'fax', 'faz')); 938 symlink_ok( file_path ('..', 'fa', 'fax', 'faz'), file_path ('fa', 'fay') ); 939 my @seen; 940 File::Find::find( {wanted => sub { 941 if (/^fa[yz]$/) { 942 push @seen, $_; 943 ok(-e $File::Find::fullname, 944 "file identified by 'fullname' exists"); 945 my $subdir = file_path qw/for_find fa fax faz/; 946 like( 947 $File::Find::fullname, 948 qr/\Q$subdir\E$/, 949 "fullname matches expected path" 950 ); 951 } 952 }, follow => 1}, topdir('fa')); 953 # make sure "fay"(symlink) found before "faz"(real file); 954 # otherwise test invalid 955 is(join(',', @seen), 'fay,faz', 956 "symlink found before real file, as expected"); 957} 958 959##### Issue 59750 ##### 960 961print "# RT 59750\n"; 962mkdir_ok( dir_path('fc'), 0770 ); 963mkdir_ok( dir_path('fc', 'fca'), 0770 ); 964mkdir_ok( dir_path('fc', 'fcb'), 0770 ); 965mkdir_ok( dir_path('fc', 'fcc'), 0770 ); 966create_file_ok( file_path('fc', 'fca', 'match_alpha') ); 967create_file_ok( file_path('fc', 'fca', 'match_beta') ); 968create_file_ok( file_path('fc', 'fcb', 'match_gamma') ); 969create_file_ok( file_path('fc', 'fcb', 'delta') ); 970create_file_ok( file_path('fc', 'fcc', 'match_epsilon') ); 971create_file_ok( file_path('fc', 'fcc', 'match_zeta') ); 972create_file_ok( file_path('fc', 'fcc', 'eta') ); 973 974my @files_from_mixed = (); 975sub wantmatch { 976 if ( $File::Find::name =~ m/match/ ) { 977 push @files_from_mixed, $_; 978 print "# \$_ => '$_'\n"; 979 } 980} 981find( \&wantmatch, ( 982 dir_path('fc', 'fca'), 983 dir_path('fc', 'fcb'), 984 dir_path('fc', 'fcc'), 985) ); 986is( scalar(@files_from_mixed), 5, 987 "Prepare test for RT #59750: got 5 'match' files as expected" ); 988 989@files_from_mixed = (); 990find( \&wantmatch, ( 991 dir_path('fc', 'fca'), 992 dir_path('fc', 'fcb'), 993 file_path('fc', 'fcc', 'match_epsilon'), 994 file_path('fc', 'fcc', 'eta'), 995) ); 996is( scalar(@files_from_mixed), 4, 997 "Can mix directories and (non-directory) files in list of directories searched by wanted()" ); 998 999##### More Win32 checks##### 1000 1001if ($^O eq 'MSWin32') { 1002 # Check F:F:f correctly handles a root directory path. 1003 # Rather than processing the entire drive (!), simply test that the 1004 # first file passed to the wanted routine is correct and then bail out. 1005 $orig_dir =~ /^(\w:)/ or die "expected a drive: $orig_dir"; 1006 my $drive = $1; 1007 1008 # Determine the file in the root directory which would be 1009 # first if processed in sorted order. Create one if necessary. 1010 my $expected_first_file; 1011 opendir(my $ROOT_DIR, "/") or die "cannot opendir /: $!\n"; 1012 foreach my $f (sort readdir $ROOT_DIR) { 1013 if (-f "/$f") { 1014 $expected_first_file = $f; 1015 last; 1016 } 1017 } 1018 closedir $ROOT_DIR; 1019 my $created_file; 1020 unless (defined $expected_first_file) { 1021 $expected_first_file = '__perl_File_Find_test.tmp'; 1022 open(F, ">", "/$expected_first_file") && close(F) 1023 or die "cannot create file in root directory: $!\n"; 1024 $created_file = 1; 1025 } 1026 1027 # Run F:F:f with/without no_chdir for each possible style of root path. 1028 # NB. If HOME were "/", then an inadvertent chdir('') would fluke the 1029 # expected result, so ensure it is something else: 1030 local $ENV{HOME} = $orig_dir; 1031 foreach my $no_chdir (0, 1) { 1032 foreach my $root_dir ("/", "\\", "$drive/", "$drive\\") { 1033 eval { 1034 File::Find::find({ 1035 'no_chdir' => $no_chdir, 1036 'preprocess' => sub { return sort @_ }, 1037 'wanted' => sub { 1038 -f or return; # the first call is for $root_dir itself. 1039 my $got = $File::Find::name; 1040 my $exp = "$root_dir$expected_first_file"; 1041 print "# no_chdir=$no_chdir $root_dir '$got'\n"; 1042 is($got, $exp, 1043 "Win32: Run 'find' with 'no_chdir' set to $no_chdir" ); 1044 die "done"; # do not process the entire drive! 1045 }, 1046 }, $root_dir); 1047 }; 1048 # If F:F:f did not die "done" then it did not Check() either. 1049 unless ($@ and $@ =~ /done/) { 1050 print "# no_chdir=$no_chdir $root_dir ", 1051 ($@ ? "error: $@" : "no files found"), "\n"; 1052 ok(0, "Win32: 0"); 1053 } 1054 } 1055 } 1056 if ($created_file) { 1057 unlink("/$expected_first_file") 1058 or warn "can't unlink /$expected_first_file: $!\n"; 1059 } 1060} 1061 1062{ 1063 local $@; 1064 eval { File::Find::find( 'foobar' ); }; 1065 like($@, qr/no &wanted subroutine given/, 1066 "find() correctly died for lack of &wanted via either coderef or hashref"); 1067} 1068 1069{ 1070 local $@; 1071 eval { File::Find::find( { follow => 1 } ); }; 1072 like($@, qr/no &wanted subroutine given/, 1073 "find() correctly died for lack of &wanted via hashref"); 1074} 1075 1076{ 1077 local $@; 1078 eval { File::Find::find( { wanted => 1 } ); }; 1079 like($@, qr/no &wanted subroutine given/, 1080 "find() correctly died: lack of coderef as value of 'wanted' element"); 1081} 1082 1083{ 1084 local $@; 1085 my $wanted = sub { print "hello world\n"; }; 1086 eval { File::Find::find( $wanted, ( undef ) ); }; 1087 like($@, qr/invalid top directory/, 1088 "find() correctly died due to undefined top directory"); 1089} 1090