Commit | Line | Data |
---|---|---|
3fa6e24b | 1 | #!./perl |
dd87e51f CB |
2 | use strict; |
3 | use Cwd; | |
81793b90 | 4 | |
3fa6e24b TW |
5 | my %Expect_File = (); # what we expect for $_ |
6 | my %Expect_Name = (); # what we expect for $File::Find::name/fullname | |
7 | my %Expect_Dir = (); # what we expect for $File::Find::dir | |
81793b90 | 8 | my $symlink_exists = eval { symlink("",""); 1 }; |
dd87e51f | 9 | my ($warn_msg, @files, $file); |
3fa6e24b | 10 | |
1a3850a5 GA |
11 | |
12 | BEGIN { | |
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 | 21 | my $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 | ||
26 | print "1..$test_count\n"; | |
27 | #if ( $symlink_exists ) { print "1..199\n"; } | |
28 | #else { print "1..85\n"; } | |
1a3850a5 | 29 | |
dd87e51f CB |
30 | my $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 |
49 | BEGIN { |
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 |
63 | cleanup(); |
64 | ||
912440be NC |
65 | $::count_commonsense = 0; |
66 | find({wanted => sub { ++$::count_commonsense if $_ eq 'commonsense.t'; } }, | |
bb7dc48b | 67 | File::Spec->curdir); |
912440be NC |
68 | if ($::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; |
75 | finddepth({wanted => sub { ++$::count_commonsense if $_ eq 'commonsense.t'; } }, | |
bb7dc48b | 76 | File::Spec->curdir); |
912440be NC |
77 | if ($::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 | 83 | my $case = 2; |
5eb85357 | 84 | my $FastFileTests_OK = 0; |
81793b90 | 85 | |
c80f55d1 | 86 | sub 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 | 120 | END { |
c80f55d1 | 121 | cleanup(); |
81793b90 GS |
122 | } |
123 | ||
124 | sub Check($) { | |
3fa6e24b TW |
125 | $case++; |
126 | if ($_[0]) { print "ok $case\n"; } | |
127 | else { print "not ok $case\n"; } | |
81793b90 GS |
128 | } |
129 | ||
130 | sub 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 | ||
136 | sub touch { | |
3fa6e24b | 137 | CheckDie( open(my $T,'>',$_[0]) ); |
81793b90 GS |
138 | } |
139 | ||
140 | sub MkDir($$) { | |
3fa6e24b | 141 | CheckDie( mkdir($_[0],$_[1]) ); |
81793b90 GS |
142 | } |
143 | ||
3fa6e24b | 144 | sub 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 |
158 | sub wanted_File_Dir_prune { |
159 | &wanted_File_Dir; | |
160 | $File::Find::prune=1 if $_ eq 'faba'; | |
81793b90 GS |
161 | } |
162 | ||
3fa6e24b TW |
163 | sub 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 |
178 | sub 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 | 192 | sub simple_wanted { |
3fa6e24b TW |
193 | print "# \$File::Find::dir => '$File::Find::dir'\n"; |
194 | print "# \$_ => '$_'\n"; | |
7e47e6ff JH |
195 | } |
196 | ||
197 | sub noop_wanted {} | |
78eac027 | 198 | |
7e47e6ff | 199 | sub 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 | ||
216 | sub 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 | |
237 | sub 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 |
265 | sub 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 | |
285 | sub 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 | |
319 | sub 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 | |
327 | MkDir( dir_path('for_find'), 0770 ); | |
328 | CheckDie(chdir( dir_path('for_find'))); | |
329 | MkDir( dir_path('fa'), 0770 ); | |
330 | MkDir( dir_path('fb'), 0770 ); | |
331 | touch( file_path('fb', 'fb_ord') ); | |
332 | MkDir( dir_path('fb', 'fba'), 0770 ); | |
333 | touch( file_path('fb', 'fba', 'fba_ord') ); | |
334 | if ($^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 | } | |
339 | touch( file_path('fa', 'fa_ord') ); | |
340 | ||
341 | MkDir( dir_path('fa', 'faa'), 0770 ); | |
342 | touch( file_path('fa', 'faa', 'faa_ord') ); | |
343 | MkDir( dir_path('fa', 'fab'), 0770 ); | |
344 | touch( file_path('fa', 'fab', 'fab_ord') ); | |
345 | MkDir( dir_path('fa', 'fab', 'faba'), 0770 ); | |
346 | touch( 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 |
354 | delete $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 |
361 | delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; |
362 | File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') ); | |
363 | Check( scalar(keys %Expect_File) == 0 ); | |
364 | ||
365 | ||
366 | print "# 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 |
373 | delete $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 | 380 | delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; |
bb7dc48b JH |
381 | |
382 | File::Find::find( {wanted => sub { wanted_File_Dir_prune(); | |
383 | File::Find::find( {wanted => sub | |
384 | {} }, File::Spec->curdir ); } }, | |
385 | topdir('fa') ); | |
386 | ||
3fa6e24b TW |
387 | Check( 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 |
402 | delete $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 | ||
412 | delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') } | |
413 | unless $symlink_exists; | |
414 | ||
415 | File::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 |
436 | delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists; |
437 | %Expect_Dir = (); | |
438 | File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir ); | |
439 | Check( 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 |
460 | delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists; |
461 | %Expect_Name = (); | |
462 | %Expect_Dir = (); | |
bb7dc48b JH |
463 | |
464 | File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1}, | |
465 | File::Spec->curdir ); | |
466 | ||
3fa6e24b TW |
467 | Check( scalar(keys %Expect_File) == 0 ); |
468 | ||
469 | ||
470 | print "# 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 | |
483 | File::Find::find( {wanted => \&noop_wanted, | |
484 | preprocess => \&my_preprocess}, File::Spec->curdir ); | |
485 | ||
3fa6e24b TW |
486 | Check( scalar(keys %Expect_Dir) == 0 ); |
487 | ||
488 | ||
489 | print "# 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 | |
502 | File::Find::find( {wanted => \&noop_wanted, | |
503 | postprocess => \&my_postprocess}, File::Spec->curdir ); | |
504 | ||
3fa6e24b TW |
505 | Check( 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 | 555 | if ( $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] | |
846 | if ($^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 | ||
902 | if ($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 | ||
935 | if ($^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 | } |