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