10 # May be doing dynamic loading while @INC is all relative
11 @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC;
13 $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; };
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';
26 my $symlink_exists = eval { symlink("",""); 1 };
28 $test_count += 119 if $symlink_exists;
29 $test_count += 26 if $^O eq 'MSWin32';
30 $test_count += 2 if $^O eq 'MSWin32' and $symlink_exists;
33 plan tests => $test_count;
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
42 # Uncomment this to see where File::Find is chdir-ing to. Helpful for
43 # debugging its little jaunts around the filesystem.
46 # *CORE::GLOBAL::chdir = sub ($) {
47 # my($file, $line) = (caller)[1,2];
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();
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.)
66 find({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } },
68 is($::count_taint, 1, "'find' found exactly 1 file named 'taint.t'");
71 finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } },
73 is($::count_taint, 1, "'finddepth' found exactly 1 file named 'taint.t'");
75 my $FastFileTests_OK = 0;
80 if (-d dir_path('for_find')) {
81 $need_updir = 1 if chdir(dir_path('for_find'));
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 rmdir dir_path('fa', 'faa');
94 rmdir dir_path('fa', 'fab', 'faba');
95 rmdir dir_path('fa', 'fab');
96 rmdir dir_path('fa', 'fac');
98 rmdir dir_path('fb', 'fba');
99 rmdir dir_path('fb', 'fbc');
100 rmdir dir_path('fb');
102 if (-d dir_path('fc')) {
104 file_path('fc', 'fca', 'match_alpha'),
105 file_path('fc', 'fca', 'match_beta'),
106 file_path('fc', 'fcb', 'match_gamma'),
107 file_path('fc', 'fcb', 'delta'),
108 file_path('fc', 'fcc', 'match_epsilon'),
109 file_path('fc', 'fcc', 'match_zeta'),
110 file_path('fc', 'fcc', 'eta'),
112 rmdir dir_path('fc', 'fca');
113 rmdir dir_path('fc', 'fcb');
114 rmdir dir_path('fc', 'fcc');
115 rmdir dir_path('fc');
118 my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir;
121 if (-d dir_path('for_find')) {
122 rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n";
130 # Wrappers around Test::More::ok() for creation of files, directories and
131 # symlinks used in testing
133 sub create_file_ok($;$) {
135 my $msg = $_[2] || "able to create file: $file";
136 ok( open(my $T,'>',$file), $msg )
137 or die("Unable to create file: $file");
141 my ($dir, $mask) = @_[0..1];
142 my $msg = $_[2] || "able to mkdir: $dir";
143 ok( mkdir($dir, $mask), $msg )
144 or die("Unable to mkdir: $dir");
147 sub symlink_ok($$;$) {
148 my ($oldfile, $newfile) = @_[0..1];
149 my $msg = $_[2] || "able to symlink from $oldfile to $newfile";
150 ok( symlink( $oldfile, $newfile ), $msg)
151 or die("Unable to symlink from $oldfile to $newfile");
154 sub wanted_File_Dir {
155 printf "# \$File::Find::dir => '$File::Find::dir'\t\$_ => '$_'\n";
156 s#\.$## if ($^O eq 'VMS' && $_ ne '.'); #
157 s/(.dir)?$//i if ($^O eq 'VMS' && -d _);
158 ok( $Expect_File{$_}, "found $_ for \$_, as expected" );
159 if ( $FastFileTests_OK ) {
160 delete $Expect_File{$_}
161 unless ( $Expect_Dir{$_} && ! -d _ );
164 delete $Expect_File{$_}
165 unless ( $Expect_Dir{$_} && ! -d $_ );
169 sub wanted_File_Dir_prune {
171 $File::Find::prune = 1 if $_ eq 'faba';
175 my $n = $File::Find::name;
176 $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.'); #
177 print "# \$File::Find::name => '$n'\n";
178 my $i = rindex($n,'/');
179 my $OK = exists($Expect_Name{$n});
181 $OK= exists($Expect_Name{substr($n,0,$i)}) if $i >= 0;
183 ok( $OK, "found $n for \$File::Find::name, as expected" );
184 delete $Expect_Name{$n};
188 print "# \$_ => '$_'\n";
189 s#\.$## if ($^O eq 'VMS' && $_ ne '.'); #
190 my $i = rindex($_,'/');
191 my $OK = exists($Expect_File{ $_});
193 $OK= exists($Expect_File{ substr($_,0,$i)}) if $i >= 0;
195 ok( $OK, "found $_ for \$_, as expected" );
196 delete $Expect_File{ $_};
200 print "# \$File::Find::dir => '$File::Find::dir'\n";
201 print "# \$_ => '$_'\n";
208 print "# --preprocess--\n";
209 print "# \$File::Find::dir => '$File::Find::dir' \n";
210 foreach my $file (@files) {
211 $file =~ s/\.(dir)?$//i if $^O eq 'VMS';
213 delete $Expect_Dir{ $File::Find::dir }->{$file};
215 print "# --end preprocess--\n";
216 is(scalar(keys %{$Expect_Dir{ $File::Find::dir }}), 0,
217 "my_preprocess: got 0, as expected");
218 if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) {
219 delete $Expect_Dir{ $File::Find::dir }
225 print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n";
226 delete $Expect_Dir{ $File::Find::dir};
229 # Use dir_path() to specify a directory path that is expected for
230 # $File::Find::dir (%Expect_Dir). Also use it in file operations like
233 # dir_path() concatenates directory names to form a *relative*
234 # directory path, independent from the platform it is run on, although
235 # there are limitations. Do not try to create an absolute path,
236 # because that may fail on operating systems that have the concept of
237 # volume names (e.g. Mac OS). As a special case, you can pass it a "."
238 # as first argument, to create a directory path like "./fa/dir". If there is
239 # no second argument, this function will return "./"
242 my $first_arg = shift @_;
244 if ($first_arg eq '.') {
245 return './' unless @_;
246 my $path = File::Spec->catdir(@_);
251 else { # $first_arg ne '.'
252 return $first_arg unless @_; # return plain filename
253 return File::Spec->catdir($first_arg, @_); # relative path
257 # Use topdir() to specify a directory path that you want to pass to
258 # find/finddepth. Historically topdir() differed on Mac OS classic.
260 *topdir = \&dir_path;
262 # Use file_path() to specify a file path that is expected for $_
263 # (%Expect_File). Also suitable for file operations like unlink etc.
265 # file_path() concatenates directory names (if any) and a filename to
266 # form a *relative* file path (the last argument is assumed to be a
267 # file). It is independent from the platform it is run on, although
268 # there are limitations. As a special case, you can pass it a "." as
269 # first argument, to create a file path like "./fa/file" on operating
270 # systems. If there is no second argument, this function will return the
274 my $first_arg = shift @_;
276 if ($first_arg eq '.') {
277 return './' unless @_;
278 my $path = File::Spec->catfile(@_);
283 else { # $first_arg ne '.'
284 return $first_arg unless @_; # return plain filename
285 return File::Spec->catfile($first_arg, @_); # relative path
289 # Use file_path_name() to specify a file path that is expected for
290 # $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
291 # option is in effect, $_ is the same as $File::Find::Name. In that
292 # case, also use this function to specify a file path that is expected
295 # Historically file_path_name differed on Mac OS classic.
297 *file_path_name = \&file_path;
299 ##### Create directories, files and symlinks used in testing #####
301 mkdir_ok( dir_path('for_find'), 0770 );
302 ok( chdir( dir_path('for_find')), "Able to chdir to 'for_find'")
303 or die("Unable to chdir to 'for_find'");
304 mkdir_ok( dir_path('fa'), 0770 );
305 mkdir_ok( dir_path('fb'), 0770 );
306 create_file_ok( file_path('fb', 'fb_ord') );
307 mkdir_ok( dir_path('fb', 'fba'), 0770 );
308 create_file_ok( file_path('fb', 'fba', 'fba_ord') );
309 if ($symlink_exists) {
310 symlink_ok('../fb','fa/fsl');
312 create_file_ok( file_path('fa', 'fa_ord') );
314 mkdir_ok( dir_path('fa', 'faa'), 0770 );
315 create_file_ok( file_path('fa', 'faa', 'faa_ord') );
316 mkdir_ok( dir_path('fa', 'fab'), 0770 );
317 create_file_ok( file_path('fa', 'fab', 'fab_ord') );
318 mkdir_ok( dir_path('fa', 'fab', 'faba'), 0770 );
319 create_file_ok( file_path('fa', 'fab', 'faba', 'faba_ord') );
321 ##### Basic tests for find() #####
322 # Set up list of files we expect to find.
323 # Run find(), removing a file from the list once we have found it.
324 # The list should be empty once we are done.
326 %Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
327 file_path('fa_ord') => 1, file_path('fab') => 1,
328 file_path('fab_ord') => 1, file_path('faba') => 1,
329 file_path('faa') => 1, file_path('faa_ord') => 1);
331 delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
334 %Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
335 dir_path('fab') => 1, dir_path('faba') => 1,
336 dir_path('fb') => 1, dir_path('fba') => 1);
338 delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
339 File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') );
340 is( scalar(keys %Expect_File), 0, "COMPLETE: Basic test of find()" );
342 ##### Re-entrancy #####
344 print "# check re-entrancy\n";
346 %Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
347 file_path('fa_ord') => 1, file_path('fab') => 1,
348 file_path('fab_ord') => 1, file_path('faba') => 1,
349 file_path('faa') => 1, file_path('faa_ord') => 1);
351 delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
354 %Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
355 dir_path('fab') => 1, dir_path('faba') => 1,
356 dir_path('fb') => 1, dir_path('fba') => 1);
358 delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
360 File::Find::find( {wanted => sub { wanted_File_Dir_prune();
361 File::Find::find( {wanted => sub
362 {} }, File::Spec->curdir ); } },
365 is( scalar(keys %Expect_File), 0, "COMPLETE: Test of find() for re-entrancy" );
367 ##### 'no_chdir' option #####
368 # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
370 %Expect_File = (file_path_name('fa') => 1,
371 file_path_name('fa', 'fsl') => 1,
372 file_path_name('fa', 'fa_ord') => 1,
373 file_path_name('fa', 'fab') => 1,
374 file_path_name('fa', 'fab', 'fab_ord') => 1,
375 file_path_name('fa', 'fab', 'faba') => 1,
376 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
377 file_path_name('fa', 'faa') => 1,
378 file_path_name('fa', 'faa', 'faa_ord') => 1,);
380 delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists;
383 %Expect_Dir = (dir_path('fa') => 1,
384 dir_path('fa', 'faa') => 1,
385 dir_path('fa', 'fab') => 1,
386 dir_path('fa', 'fab', 'faba') => 1,
388 dir_path('fb', 'fba') => 1);
390 delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') }
391 unless $symlink_exists;
393 File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1},
395 is( scalar(keys %Expect_File), 0, "COMPLETE: Test of 'no_chdir' option" );
397 ##### Test for $File::Find::name #####
401 %Expect_Name = (File::Spec->curdir => 1,
402 file_path_name('.', 'fa') => 1,
403 file_path_name('.', 'fa', 'fsl') => 1,
404 file_path_name('.', 'fa', 'fa_ord') => 1,
405 file_path_name('.', 'fa', 'fab') => 1,
406 file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
407 file_path_name('.', 'fa', 'fab', 'faba') => 1,
408 file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
409 file_path_name('.', 'fa', 'faa') => 1,
410 file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
411 file_path_name('.', 'fb') => 1,
412 file_path_name('.', 'fb', 'fba') => 1,
413 file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
414 file_path_name('.', 'fb', 'fb_ord') => 1);
416 delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists;
418 File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir );
419 is( scalar(keys %Expect_Name), 0, "COMPLETE: Test for \$File::Find::name" );
423 # no_chdir is in effect, hence we use file_path_name to specify the
424 # expected paths for %Expect_File
426 %Expect_File = (File::Spec->curdir => 1,
427 file_path_name('.', 'fa') => 1,
428 file_path_name('.', 'fa', 'fsl') => 1,
429 file_path_name('.', 'fa', 'fa_ord') => 1,
430 file_path_name('.', 'fa', 'fab') => 1,
431 file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
432 file_path_name('.', 'fa', 'fab', 'faba') => 1,
433 file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
434 file_path_name('.', 'fa', 'faa') => 1,
435 file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
436 file_path_name('.', 'fb') => 1,
437 file_path_name('.', 'fb', 'fba') => 1,
438 file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
439 file_path_name('.', 'fb', 'fb_ord') => 1);
441 delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists;
445 File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1},
446 File::Spec->curdir );
448 is( scalar(keys %Expect_File), 0,
449 "COMPLETE: Equivalency of \$_ and \$File::Find::Name with 'no_chdir'" );
453 print "# check preprocess\n";
457 File::Spec->curdir => {fa => 1, fb => 1},
458 dir_path('.', 'fa') => {faa => 1, fab => 1, fa_ord => 1},
459 dir_path('.', 'fa', 'faa') => {faa_ord => 1},
460 dir_path('.', 'fa', 'fab') => {faba => 1, fab_ord => 1},
461 dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1},
462 dir_path('.', 'fb') => {fba => 1, fb_ord => 1},
463 dir_path('.', 'fb', 'fba') => {fba_ord => 1}
466 File::Find::find( {wanted => \&noop_wanted,
467 preprocess => \&my_preprocess}, File::Spec->curdir );
469 is( scalar(keys %Expect_Dir), 0, "Got no files, as expected" );
473 print "# check postprocess\n";
477 File::Spec->curdir => 1,
478 dir_path('.', 'fa') => 1,
479 dir_path('.', 'fa', 'faa') => 1,
480 dir_path('.', 'fa', 'fab') => 1,
481 dir_path('.', 'fa', 'fab', 'faba') => 1,
482 dir_path('.', 'fb') => 1,
483 dir_path('.', 'fb', 'fba') => 1
486 File::Find::find( {wanted => \&noop_wanted,
487 postprocess => \&my_postprocess}, File::Spec->curdir );
489 is( scalar(keys %Expect_Dir), 0, "Got no files, as expected" );
493 print "# checking argument localization\n";
495 ### this checks the fix of perlbug [19977] ###
496 my @foo = qw( a b c d e f );
497 my %pre = map { $_ => } @foo;
499 File::Find::find( sub { } , 'fa' ) for @foo;
500 delete $pre{$_} for @foo;
502 is( scalar(keys %pre), 0, "Got no files, as expected" );
506 # see thread starting
507 # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-02/msg00351.html
509 print "# checking that &_ and %_ are still accessible and that\n",
510 "# tie magic on \$_ is not triggered\n";
523 sub FETCH {return 'N'};
524 sub TIESCALAR {bless []};
527 is( scalar(keys %_), 0, "Got no files, as expected" );
531 File::Find::find( sub { $true_count++; $_{$_}++; &_; } , 'fa' ) for @foo;
534 is( $tie_called, 0, "Got no files tie_called, as expected" );
535 is( scalar(keys %_), $true_count, "Got true count, as expected" );
536 is( $sub, $true_count, "Got true count, as expected" );
537 is( scalar( @foo), 1, "Got one file, as expected" );
538 is( $foo[0], 'N', "Got 'N', as expected" );
542 if ( $symlink_exists ) {
543 print "# --- symbolic link tests --- \n";
544 $FastFileTests_OK= 1;
546 # 'follow', 'follow_fast' and 'follow_skip' options only apply when a
547 # platform supports symlinks.
551 # Verify that File::Find::find will call wanted even if the topdir
552 # is a symlink to a directory, and it should not follow the link
553 # unless follow is set, which it is not in this case
554 %Expect_File = ( file_path('fsl') => 1 );
557 File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') );
558 is( scalar(keys %Expect_File), 0,
559 "COMPLETE: top dir can be symlink to dir; link not followed without 'follow' option" );
563 %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1,
564 file_path('fsl') => 1, file_path('fb_ord') => 1,
565 file_path('fba') => 1, file_path('fba_ord') => 1,
566 file_path('fab') => 1, file_path('fab_ord') => 1,
567 file_path('faba') => 1, file_path('faa') => 1,
568 file_path('faa_ord') => 1);
572 %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1,
573 dir_path('faa') => 1, dir_path('fab') => 1,
574 dir_path('faba') => 1, dir_path('fb') => 1,
575 dir_path('fba') => 1);
577 File::Find::find( {wanted => \&wanted_File_Dir_prune,
578 follow_fast => 1}, topdir('fa') );
580 is( scalar(keys %Expect_File), 0,
581 "COMPLETE: test of 'follow_fast' option: \$_ case" );
585 # no_chdir is in effect, hence we use file_path_name to specify
586 # the expected paths for %Expect_File
588 %Expect_File = (file_path_name('fa') => 1,
589 file_path_name('fa', 'fa_ord') => 1,
590 file_path_name('fa', 'fsl') => 1,
591 file_path_name('fa', 'fsl', 'fb_ord') => 1,
592 file_path_name('fa', 'fsl', 'fba') => 1,
593 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
594 file_path_name('fa', 'fab') => 1,
595 file_path_name('fa', 'fab', 'fab_ord') => 1,
596 file_path_name('fa', 'fab', 'faba') => 1,
597 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
598 file_path_name('fa', 'faa') => 1,
599 file_path_name('fa', 'faa', 'faa_ord') => 1);
603 %Expect_Dir = (dir_path('fa') => 1,
604 dir_path('fa', 'faa') => 1,
605 dir_path('fa', 'fab') => 1,
606 dir_path('fa', 'fab', 'faba') => 1,
608 dir_path('fb', 'fba') => 1);
610 File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
611 no_chdir => 1}, topdir('fa') );
613 is( scalar(keys %Expect_File), 0,
614 "COMPLETE: Test of 'follow_fast' and 'no_chdir' options together: \$_ case" );
620 %Expect_Name = (file_path_name('fa') => 1,
621 file_path_name('fa', 'fa_ord') => 1,
622 file_path_name('fa', 'fsl') => 1,
623 file_path_name('fa', 'fsl', 'fb_ord') => 1,
624 file_path_name('fa', 'fsl', 'fba') => 1,
625 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
626 file_path_name('fa', 'fab') => 1,
627 file_path_name('fa', 'fab', 'fab_ord') => 1,
628 file_path_name('fa', 'fab', 'faba') => 1,
629 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
630 file_path_name('fa', 'faa') => 1,
631 file_path_name('fa', 'faa', 'faa_ord') => 1);
635 File::Find::finddepth( {wanted => \&wanted_Name,
636 follow_fast => 1}, topdir('fa') );
638 is( scalar(keys %Expect_Name), 0,
639 "COMPLETE: test of 'follow_fast' option: \$File::Find::name case" );
643 # no_chdir is in effect, hence we use file_path_name to specify
644 # the expected paths for %Expect_File
646 %Expect_File = (file_path_name('fa') => 1,
647 file_path_name('fa', 'fa_ord') => 1,
648 file_path_name('fa', 'fsl') => 1,
649 file_path_name('fa', 'fsl', 'fb_ord') => 1,
650 file_path_name('fa', 'fsl', 'fba') => 1,
651 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
652 file_path_name('fa', 'fab') => 1,
653 file_path_name('fa', 'fab', 'fab_ord') => 1,
654 file_path_name('fa', 'fab', 'faba') => 1,
655 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
656 file_path_name('fa', 'faa') => 1,
657 file_path_name('fa', 'faa', 'faa_ord') => 1);
662 File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1,
663 no_chdir => 1}, topdir('fa') );
665 is( scalar(keys %Expect_File), 0,
666 "COMPLETE: Test of 'follow_fast' and 'no_chdir' options together: \$File::Find::name case" );
670 print "# check dangling symbolic links\n";
671 mkdir_ok( dir_path('dangling_dir'), 0770 );
672 symlink_ok( dir_path('dangling_dir'), file_path('dangling_dir_sl'),
673 "Check dangling directory" );
674 rmdir dir_path('dangling_dir');
675 create_file_ok(file_path('dangling_file'));
676 symlink_ok('../dangling_file','fa/dangling_file_sl',
677 "Check dangling file" );
678 unlink file_path('dangling_file');
681 # these tests should also emit a warning
684 %Expect_File = (File::Spec->curdir => 1,
685 file_path('dangling_file_sl') => 1,
686 file_path('fa_ord') => 1,
687 file_path('fsl') => 1,
688 file_path('fb_ord') => 1,
689 file_path('fba') => 1,
690 file_path('fba_ord') => 1,
691 file_path('fab') => 1,
692 file_path('fab_ord') => 1,
693 file_path('faba') => 1,
694 file_path('faba_ord') => 1,
695 file_path('faa') => 1,
696 file_path('faa_ord') => 1);
702 File::Find::find( {wanted => \&wanted_File, follow => 1,
704 sub { $warn_msg = "$_[0] is a dangling symbolic link" }
706 topdir('dangling_dir_sl'), topdir('fa') );
708 is( scalar(keys %Expect_File), 0,
709 "COMPLETE: test of 'follow' and 'dangling_symlinks' options" );
710 like( $warn_msg, qr/dangling_file_sl is a dangling symbolic link/,
711 "Got expected warning message re dangling symbolic link" );
712 unlink file_path('fa', 'dangling_file_sl'),
713 file_path('dangling_dir_sl');
719 print "# check recursion\n";
720 symlink_ok('../faa','fa/faa/faa_sl');
722 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
723 no_chdir => 1}, topdir('fa') ); };
726 qr{for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link}i,
727 "Got expected error message for recursive symbolic link"
729 unlink file_path('fa', 'faa', 'faa_sl');
732 print "# check follow_skip (file)\n";
733 symlink_ok('./fa_ord','fa/fa_ord_sl');
736 eval {File::Find::finddepth( {wanted => \&simple_wanted,
738 follow_skip => 0, no_chdir => 1},
743 qr{for_find[:/]fa[:/]fa_ord encountered a second time}i,
744 "'follow_skip==0': got error message when file encountered a second time"
749 # no_chdir is in effect, hence we use file_path_name to specify
750 # the expected paths for %Expect_File
752 %Expect_File = (file_path_name('fa') => 1,
753 file_path_name('fa', 'fa_ord') => 2,
754 # We may encounter the symlink first
755 file_path_name('fa', 'fa_ord_sl') => 2,
756 file_path_name('fa', 'fsl') => 1,
757 file_path_name('fa', 'fsl', 'fb_ord') => 1,
758 file_path_name('fa', 'fsl', 'fba') => 1,
759 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
760 file_path_name('fa', 'fab') => 1,
761 file_path_name('fa', 'fab', 'fab_ord') => 1,
762 file_path_name('fa', 'fab', 'faba') => 1,
763 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
764 file_path_name('fa', 'faa') => 1,
765 file_path_name('fa', 'faa', 'faa_ord') => 1);
769 %Expect_Dir = (dir_path('fa') => 1,
770 dir_path('fa', 'faa') => 1,
771 dir_path('fa', 'fab') => 1,
772 dir_path('fa', 'fab', 'faba') => 1,
774 dir_path('fb','fba') => 1);
776 File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1,
777 follow_skip => 1, no_chdir => 1},
779 is( scalar(keys %Expect_File), 0,
780 "COMPLETE: Test of 'follow', 'follow_skip==1' and 'no_chdir' options" );
781 unlink file_path('fa', 'fa_ord_sl');
784 print "# check follow_skip (directory)\n";
785 symlink_ok('./faa','fa/faa_sl');
788 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
789 follow_skip => 0, no_chdir => 1},
794 qr{for_find[:/]fa[:/]faa[:/]? encountered a second time}i,
795 "'follow_skip==0': got error message when directory encountered a second time"
801 eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
802 follow_skip => 1, no_chdir => 1},
807 qr{for_find[:/]fa[:/]faa[:/]? encountered a second time}i,
808 "'follow_skip==1': got error message when directory encountered a second time"
813 # no_chdir is in effect, hence we use file_path_name to specify
814 # the expected paths for %Expect_File
816 %Expect_File = (file_path_name('fa') => 1,
817 file_path_name('fa', 'fa_ord') => 1,
818 file_path_name('fa', 'fsl') => 1,
819 file_path_name('fa', 'fsl', 'fb_ord') => 1,
820 file_path_name('fa', 'fsl', 'fba') => 1,
821 file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
822 file_path_name('fa', 'fab') => 1,
823 file_path_name('fa', 'fab', 'fab_ord') => 1,
824 file_path_name('fa', 'fab', 'faba') => 1,
825 file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
826 file_path_name('fa', 'faa') => 1,
827 file_path_name('fa', 'faa', 'faa_ord') => 1,
828 # We may actually encounter the symlink first.
829 file_path_name('fa', 'faa_sl') => 1,
830 file_path_name('fa', 'faa_sl', 'faa_ord') => 1);
834 %Expect_Dir = (dir_path('fa') => 1,
835 dir_path('fa', 'faa') => 1,
836 dir_path('fa', 'fab') => 1,
837 dir_path('fa', 'fab', 'faba') => 1,
839 dir_path('fb', 'fba') => 1);
841 File::Find::find( {wanted => \&wanted_File_Dir, follow => 1,
842 follow_skip => 2, no_chdir => 1}, topdir('fa') );
846 # If we encountered the symlink first, then the entries corresponding to
847 # the real name remain, if the real name first then the symlink
848 my @names = sort keys %Expect_File;
849 is( scalar(@names), 1,
850 "'follow_skip==2'" );
851 # Normalise both to the original name
852 s/_sl// foreach @names;
855 file_path_name('fa', 'faa', 'faa_ord'),
856 "Got file_path_name, as expected"
858 unlink file_path('fa', 'faa_sl');
862 ##### Win32 checks - [perl #41555] #####
864 if ($^O eq 'MSWin32') {
865 require File::Spec::Win32;
866 my ($volume) = File::Spec::Win32->splitpath($orig_dir, 1);
867 print STDERR "VOLUME = $volume\n";
872 %Expect_File = (File::Spec->curdir => 1,
873 file_path('fsl') => 1,
874 file_path('fa_ord') => 1,
875 file_path('fab') => 1,
876 file_path('fab_ord') => 1,
877 file_path('faba') => 1,
878 file_path('faba_ord') => 1,
879 file_path('faa') => 1,
880 file_path('faa_ord') => 1);
882 delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
885 %Expect_Dir = (dir_path('fa') => 1,
886 dir_path('faa') => 1,
887 dir_path('fab') => 1,
888 dir_path('faba') => 1,
890 dir_path('fba') => 1);
892 File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa'));
893 is( scalar(keys %Expect_File), 0, "Got no files, as expected" );
898 %Expect_File = ($volume . file_path_name('fa') => 1,
899 $volume . file_path_name('fa', 'fsl') => 1,
900 $volume . file_path_name('fa', 'fa_ord') => 1,
901 $volume . file_path_name('fa', 'fab') => 1,
902 $volume . file_path_name('fa', 'fab', 'fab_ord') => 1,
903 $volume . file_path_name('fa', 'fab', 'faba') => 1,
904 $volume . file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
905 $volume . file_path_name('fa', 'faa') => 1,
906 $volume . file_path_name('fa', 'faa', 'faa_ord') => 1);
909 delete $Expect_File{ $volume . file_path_name('fa', 'fsl') } unless $symlink_exists;
912 %Expect_Dir = ($volume . dir_path('fa') => 1,
913 $volume . dir_path('fa', 'faa') => 1,
914 $volume . dir_path('fa', 'fab') => 1,
915 $volume . dir_path('fa', 'fab', 'faba') => 1);
917 File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, $volume . topdir('fa'));
918 is( scalar(keys %Expect_File), 0, "Got no files, as expected" );
922 ##### Issue 68260 #####
924 if ($symlink_exists) {
925 print "# BUG 68260\n";
926 mkdir_ok(dir_path ('fa', 'fac'), 0770);
927 mkdir_ok(dir_path ('fb', 'fbc'), 0770);
928 create_file_ok(file_path ('fa', 'fac', 'faca'));
929 symlink_ok('..////../fa/fac/faca', 'fb/fbc/fbca',
930 "RT 68260: able to symlink");
933 my $dangling_symlink;
934 local $SIG {__WARN__} = sub {
936 $dangling_symlink ++ if "@_" =~ /dangling symbolic link/;
944 dangling_symlinks => 1,
949 ok(!$dangling_symlink, "Found no dangling symlink");
952 ##### Issue 59750 #####
954 print "# RT 59750\n";
955 mkdir_ok( dir_path('fc'), 0770 );
956 mkdir_ok( dir_path('fc', 'fca'), 0770 );
957 mkdir_ok( dir_path('fc', 'fcb'), 0770 );
958 mkdir_ok( dir_path('fc', 'fcc'), 0770 );
959 create_file_ok( file_path('fc', 'fca', 'match_alpha') );
960 create_file_ok( file_path('fc', 'fca', 'match_beta') );
961 create_file_ok( file_path('fc', 'fcb', 'match_gamma') );
962 create_file_ok( file_path('fc', 'fcb', 'delta') );
963 create_file_ok( file_path('fc', 'fcc', 'match_epsilon') );
964 create_file_ok( file_path('fc', 'fcc', 'match_zeta') );
965 create_file_ok( file_path('fc', 'fcc', 'eta') );
967 my @files_from_mixed = ();
969 if ( $File::Find::name =~ m/match/ ) {
970 push @files_from_mixed, $_;
971 print "# \$_ => '$_'\n";
975 dir_path('fc', 'fca'),
976 dir_path('fc', 'fcb'),
977 dir_path('fc', 'fcc'),
979 is( scalar(@files_from_mixed), 5,
980 "Prepare test for RT #59750: got 5 'match' files as expected" );
982 @files_from_mixed = ();
984 dir_path('fc', 'fca'),
985 dir_path('fc', 'fcb'),
986 file_path('fc', 'fcc', 'match_epsilon'),
987 file_path('fc', 'fcc', 'eta'),
989 is( scalar(@files_from_mixed), 4,
990 "Can mix directories and (non-directory) files in list of directories searched by wanted()" );
992 ##### More Win32 checks#####
994 if ($^O eq 'MSWin32') {
995 # Check F:F:f correctly handles a root directory path.
996 # Rather than processing the entire drive (!), simply test that the
997 # first file passed to the wanted routine is correct and then bail out.
998 $orig_dir =~ /^(\w:)/ or die "expected a drive: $orig_dir";
1001 # Determine the file in the root directory which would be
1002 # first if processed in sorted order. Create one if necessary.
1003 my $expected_first_file;
1004 opendir(my $ROOT_DIR, "/") or die "cannot opendir /: $!\n";
1005 foreach my $f (sort readdir $ROOT_DIR) {
1007 $expected_first_file = $f;
1013 unless (defined $expected_first_file) {
1014 $expected_first_file = '__perl_File_Find_test.tmp';
1015 open(F, ">", "/$expected_first_file") && close(F)
1016 or die "cannot create file in root directory: $!\n";
1020 # Run F:F:f with/without no_chdir for each possible style of root path.
1021 # NB. If HOME were "/", then an inadvertent chdir('') would fluke the
1022 # expected result, so ensure it is something else:
1023 local $ENV{HOME} = $orig_dir;
1024 foreach my $no_chdir (0, 1) {
1025 foreach my $root_dir ("/", "\\", "$drive/", "$drive\\") {
1028 'no_chdir' => $no_chdir,
1029 'preprocess' => sub { return sort @_ },
1031 -f or return; # the first call is for $root_dir itself.
1032 my $got = $File::Find::name;
1033 my $exp = "$root_dir$expected_first_file";
1034 print "# no_chdir=$no_chdir $root_dir '$got'\n";
1036 "Win32: Run 'find' with 'no_chdir' set to $no_chdir" );
1037 die "done"; # do not process the entire drive!
1041 # If F:F:f did not die "done" then it did not Check() either.
1042 unless ($@ and $@ =~ /done/) {
1043 print "# no_chdir=$no_chdir $root_dir ",
1044 ($@ ? "error: $@" : "no files found"), "\n";
1049 if ($created_file) {
1050 unlink("/$expected_first_file")
1051 or warn "can't unlink /$expected_first_file: $!\n";