ext/File-Find/t/find.t

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