diff --git a/MANIFEST b/MANIFEST index 1ae6bf8541a4..b06785320163 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4265,6 +4265,7 @@ ext/File-DosGlob/DosGlob.xs Win32 DOS-globbing module ext/File-DosGlob/lib/File/DosGlob.pm Win32 DOS-globbing module ext/File-DosGlob/t/DosGlob.t See if File::DosGlob works ext/File-Find/lib/File/Find.pm Routines to do a find +ext/File-Find/t/correct-absolute-path-with-follow.t ext/File-Find/t/find.t See if File::Find works ext/File-Find/t/lib/Testing.pm Functions used in testing File-find ext/File-Find/t/taint.t See if File::Find works with taint diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index b3e4ebc68ca8..5969bcbc6dc6 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -172,6 +172,7 @@ package Maintainers; 'DISTRIBUTION' => 'SMUELLER/AutoLoader-5.74.tar.gz', 'FILES' => q[cpan/AutoLoader], 'EXCLUDED' => ['t/00pod.t'], + 'CUSTOMIZED' => ['t/02AutoSplit.t'], }, 'autouse' => { diff --git a/cpan/AutoLoader/t/02AutoSplit.t b/cpan/AutoLoader/t/02AutoSplit.t index f220a76cdc58..b50c6f2d0c65 100644 --- a/cpan/AutoLoader/t/02AutoSplit.t +++ b/cpan/AutoLoader/t/02AutoSplit.t @@ -149,8 +149,12 @@ foreach (@tests) { if ($args{Files}) { $args{Files} =~ s!/!:!gs if $^O eq 'MacOS'; + $args{Files} =~ s!\\!/!g if $^O eq 'MSWin32'; my (%missing, %got); - find (sub {$got{$File::Find::name}++ unless -d $_}, $dir); + find( + sub { (my $f = $File::Find::name) =~ s!\\!/!g; $got{$f}++ unless -d $_ }, + $dir + ); foreach (split /\n/, $args{Files}) { next if /^#/; $_ = lc($_) if $Is_VMS_lc; diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm index c2b88a97fa4b..afa3d8c1f65f 100644 --- a/ext/File-Find/lib/File/Find.pm +++ b/ext/File-Find/lib/File/Find.pm @@ -43,11 +43,21 @@ sub contract_name { return $abs_name; } +sub _is_absolute { + return $_[0] =~ m|^(?:[A-Za-z]:)?/| if $Is_Win32; + return substr($_[0], 0, 1) eq '/'; +} + +sub _is_root { + return $_[0] =~ m|^(?:[A-Za-z]:)?/\z| if $Is_Win32; + return $_[0] eq '/'; +} + sub PathCombine($$) { my ($Base,$Name) = @_; my $AbsName; - if (substr($Name,0,1) eq '/') { + if (_is_absolute($Name)) { $AbsName= $Name; } else { @@ -123,6 +133,7 @@ sub is_tainted_pp { return length($@) != 0; } + sub _find_opt { my $wanted = shift; return unless @_; @@ -183,19 +194,17 @@ sub _find_opt { ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item; - if ($Is_Win32) { - $top_item =~ s|[/\\]\z|| - unless $top_item =~ m{^(?:\w:)?[/\\]$}; - } - else { - $top_item =~ s|/\z|| unless $top_item eq '/'; - } + # canonicalize directory separators + $top_item =~ s|[/\\]|/|g if $Is_Win32; + + # no trailing / unless path is root + $top_item =~ s|/\z|| unless _is_root($top_item); $Is_Dir= 0; if ($follow) { - if (substr($top_item,0,1) eq '/') { + if (_is_absolute($top_item)) { $abs_dir = $top_item; } elsif ($top_item eq $File::Find::current_dir) { @@ -304,11 +313,7 @@ sub _find_dir($$$) { my $tainted = 0; my $no_nlink; - if ($Is_Win32) { - $dir_pref - = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" ); - } elsif ($Is_VMS) { - + if ($Is_VMS) { # VMS is returning trailing .dir on directories # and trailing . on files and symbolic links # in UNIX syntax. @@ -319,7 +324,7 @@ sub _find_dir($$$) { $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" ); } else { - $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" ); + $dir_pref = _is_root($p_dir) ? $p_dir : "$p_dir/"; } local ($dir, $name, $prune); @@ -471,12 +476,7 @@ sub _find_dir($$$) { $CdLvl = $Level; } - if ($Is_Win32) { - $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} - ? "$p_dir$dir_rel" : "$p_dir/$dir_rel"); - $dir_pref = "$dir_name/"; - } - elsif ($^O eq 'VMS') { + if ($^O eq 'VMS') { if ($p_dir =~ m/[\]>]+$/) { $dir_name = $p_dir; $dir_name =~ s/([\]>]+)$/.$dir_rel$1/; @@ -488,7 +488,7 @@ sub _find_dir($$$) { } } else { - $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); + $dir_name = _is_root($p_dir) ? "$p_dir$dir_rel" : "$p_dir/$dir_rel"; $dir_pref = "$dir_name/"; } @@ -540,8 +540,8 @@ sub _find_dir_symlnk($$$) { my $tainted = 0; my $ok = 1; - $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" ); - $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" ); + $dir_pref = _is_root($p_dir) ? $p_dir : "$p_dir/"; + $loc_pref = _is_root($dir_loc) ? $dir_loc : "$dir_loc/"; local ($dir, $name, $fullname, $prune); @@ -677,7 +677,7 @@ sub _find_dir_symlnk($$$) { continue { while (defined($SE = pop @Stack)) { ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE; - $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); + $dir_name = _is_root($p_dir) ? "$p_dir$dir_rel" : "$p_dir/$dir_rel"; $dir_pref = "$dir_name/"; $loc_pref = "$dir_loc/"; if ( $byd_flag < 0 ) { # must be finddepth, report dirname now diff --git a/ext/File-Find/t/correct-absolute-path-with-follow.t b/ext/File-Find/t/correct-absolute-path-with-follow.t new file mode 100644 index 000000000000..929a33968359 --- /dev/null +++ b/ext/File-Find/t/correct-absolute-path-with-follow.t @@ -0,0 +1,63 @@ +#!./perl + +use strict; +use warnings; + +use File::Find qw( find finddepth ); +use File::Temp qw(); +use Test::More; + +my $warn_msg; + +BEGIN { + $SIG{'__WARN__'} = sub { + $warn_msg = $_[0]; + warn "# $_[0]"; + return; + } +} + +sub test_find_correct_paths_with_follow { + $warn_msg = ''; + my $dir = File::Temp->newdir('file-find-XXXXXX', TMPDIR => 1, CLEANUP => 1); + + find( + { + follow => 1, + wanted => sub { return }, + }, + $dir, + ); + + unlike( + $warn_msg, + qr/Couldn't chdir/, + 'find: Derive absolute path correctly with follow => 1', + ); +} + +sub test_finddepth_correct_paths_with_follow { + $warn_msg = ''; + my $dir = File::Temp->newdir('file-find-XXXXXX', TMPDIR => 1, CLEANUP => 1); + + finddepth( + { + follow => 1, + wanted => sub { return }, + }, + $dir, + ); + + unlike( + $warn_msg, + qr/Couldn't chdir/, + 'finddepth: Derive absolute path correctly with follow => 1', + ); +} +sub run { + test_find_correct_paths_with_follow; + test_finddepth_correct_paths_with_follow; + done_testing; +} + +run(); diff --git a/ext/File-Find/t/find.t b/ext/File-Find/t/find.t index add20c268394..6b78296a88ed 100644 --- a/ext/File-Find/t/find.t +++ b/ext/File-Find/t/find.t @@ -1060,7 +1060,7 @@ if ($^O eq 'MSWin32') { 'wanted' => sub { -f or return; # the first call is for $root_dir itself. my $got = $File::Find::name; - my $exp = "$root_dir$expected_first_file"; + (my $exp = "$root_dir$expected_first_file") =~ s|\\|/|g; print "# no_chdir=$no_chdir $root_dir '$got'\n"; is($got, $exp, "Win32: Run 'find' with 'no_chdir' set to $no_chdir" ); diff --git a/t/porting/customized.dat b/t/porting/customized.dat index d79ed6b27a0c..dae5af24467b 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -1,6 +1,7 @@ # Regenerate this file using: # cd t # ./perl -I../lib porting/customized.t --regen +AutoLoader cpan/AutoLoader/t/02AutoSplit.t bb90cda13b88599ad45de4b45799d5218afcb6d8 ExtUtils::Constant cpan/ExtUtils-Constant/lib/ExtUtils/Constant/Base.pm 7560e1018f806db5689dee78728ccb8374aea741 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t 165e9c7132b003fd192d32a737b0f51f9ba4999e Filter::Util::Call pod/perlfilter.pod 545265af2f45741a0e59eecdd0cfc0c9e490c1e8