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