This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Standardize subroutine definitions between tests.
[perl5.git] / 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     print "# \$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 }