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