In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/a0b245d5e289be3bb051fa91ac65fec84cf27e6d?hp=1393fe000d6be26b7927c85788f02d6ea124d991>
- Log -----------------------------------------------------------------
commit a0b245d5e289be3bb051fa91ac65fec84cf27e6d
Author: Alex Davies <alex.dav...@talktalk.net>
Date: Thu Sep 23 17:23:49 2010 -0700
[perl #71710] fixes for File::Find
Please find attached patches for File::Find and its test file.
These changes ensure that paths passed to File::Find::find() on Win32
which have a trailing *back*slash are neatly handled. That is, the
change ensures paths such as c:\dir\/file are no longer generated.
-----------------------------------------------------------------------
Summary of changes:
lib/File/Find.pm | 19 ++++++++------
lib/File/Find/t/find.t | 63 +++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 73 insertions(+), 9 deletions(-)
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 2967bd3..27c9466 100644
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -3,7 +3,7 @@ use 5.006;
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.17';
+our $VERSION = '1.18';
require Exporter;
require Cwd;
@@ -423,6 +423,7 @@ our @EXPORT = qw(find finddepth);
use strict;
my $Is_VMS;
+my $Is_Win32;
require File::Basename;
require File::Spec;
@@ -616,8 +617,8 @@ sub _find_opt {
$pre_process = $wanted->{preprocess};
$post_process = $wanted->{postprocess};
$no_chdir = $wanted->{no_chdir};
- $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
- $follow = $^O eq 'MSWin32' ? 0 :
+ $full_check = $Is_Win32 ? 0 : $wanted->{follow};
+ $follow = $Is_Win32 ? 0 :
$full_check || $wanted->{follow_fast};
$follow_skip = $wanted->{follow_skip};
$untaint = $wanted->{untaint};
@@ -639,8 +640,9 @@ sub _find_opt {
($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat
$top_item;
- if ($^O eq 'MSWin32') {
- $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
+ if ($Is_Win32) {
+ $top_item =~ s|[/\\]\z||
+ unless $top_item =~ m{^(?:\w:)?[/\\]$};
}
else {
$top_item =~ s|/\z|| unless $top_item eq '/';
@@ -759,9 +761,10 @@ sub _find_dir($$$) {
my $tainted = 0;
my $no_nlink;
- if ($^O eq 'MSWin32') {
- $dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
- } elsif ($^O eq 'VMS') {
+ if ($Is_Win32) {
+ $dir_pref
+ = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
+ } elsif ($Is_VMS) {
# VMS is returning trailing .dir on directories
# and trailing . on files and symbolic links
diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t
index 27e08be..f386668 100644
--- a/lib/File/Find/t/find.t
+++ b/lib/File/Find/t/find.t
@@ -20,7 +20,7 @@ BEGIN {
my $test_count = 85;
$test_count += 119 if $symlink_exists;
-$test_count += 18 if $^O eq 'MSWin32';
+$test_count += 26 if $^O eq 'MSWin32';
$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists;
print "1..$test_count\n";
@@ -930,3 +930,64 @@ if ($symlink_exists) { # Issue 68260
Check (!$dangling_symlink);
}
+
+
+if ($^O eq 'MSWin32') {
+ # Check F:F:f correctly handles a root directory path.
+ # Rather than processing the entire drive (!), simply test that the
+ # first file passed to the wanted routine is correct and then bail out.
+ $orig_dir =~ /^(\w:)/ or die "expected a drive: $orig_dir";
+ my $drive = $1;
+
+ # Determine the file in the root directory which would be
+ # first if processed in sorted order. Create one if necessary.
+ my $expected_first_file;
+ opendir(ROOT_DIR, "/") or die "cannot opendir /: $!\n";
+ foreach my $f (sort readdir ROOT_DIR) {
+ if (-f "/$f") {
+ $expected_first_file = $f;
+ last;
+ }
+ }
+ closedir ROOT_DIR;
+ my $created_file;
+ unless (defined $expected_first_file) {
+ $expected_first_file = '__perl_File_Find_test.tmp';
+ open(F, ">", "/$expected_first_file") && close(F)
+ or die "cannot create file in root directory: $!\n";
+ $created_file = 1;
+ }
+
+ # Run F:F:f with/without no_chdir for each possible style of root path.
+ # NB. If HOME were "/", then an inadvertent chdir('') would fluke the
+ # expected result, so ensure it is something else:
+ local $ENV{HOME} = $orig_dir;
+ foreach my $no_chdir (0, 1) {
+ foreach my $root_dir ("/", "\\", "$drive/", "$drive\\") {
+ eval {
+ File::Find::find({
+ 'no_chdir' => $no_chdir,
+ 'preprocess' => sub { return sort @_ },
+ '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";
+ print "# no_chdir=$no_chdir $root_dir '$got'\n";
+ Check($got eq $exp);
+ die "done"; # don't process the entire drive!
+ },
+ }, $root_dir);
+ };
+ # If F:F:f did not die "done" then it did not Check() either.
+ unless ($@ and $@ =~ /done/) {
+ print "# no_chdir=$no_chdir $root_dir ",
+ ($@ ? "error: $@" : "no files found"), "\n";
+ Check(0);
+ }
+ }
+ }
+ if ($created_file) {
+ unlink("/$expected_first_file")
+ or warn "can't unlink /$expected_first_file: $!\n";
+ }
+}
--
Perl5 Master Repository
