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