[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.

2 files changed, 73 insertions, 9 deletions

diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 2967bd375b..27c9466e74 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 27e08bea1a..f386668d9d 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";
+    }
+}