This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
File::Find: support Win32 symlinks
authorTony Cook <tony@develop-help.com>
Wed, 7 Oct 2020 01:07:31 +0000 (12:07 +1100)
committerTony Cook <tony@develop-help.com>
Tue, 1 Dec 2020 04:29:33 +0000 (15:29 +1100)
find.t, taint.t: check that symlink() works under the current
permissions/filesystem rather than assuming it will work

find.t: since symlinks are now available, an earlier test block
set $FileFileTests_OK, and the tests in this Win32 block don't use
either of the follow options, which is required for fast file tests.

taint.t: ensure we get "/" separated names to match File::Find's output

ext/File-Find/lib/File/Find.pm
ext/File-Find/t/find.t
ext/File-Find/t/lib/Testing.pm
ext/File-Find/t/taint.t

index 4c67e88..01dbc8b 100644 (file)
@@ -3,7 +3,7 @@ use 5.006;
 use strict;
 use warnings;
 use warnings::register;
-our $VERSION = '1.37';
+our $VERSION = '1.38';
 require Exporter;
 require Cwd;
 
@@ -161,9 +161,8 @@ sub _find_opt {
     $pre_process       = $wanted->{preprocess};
     $post_process      = $wanted->{postprocess};
     $no_chdir          = $wanted->{no_chdir};
-    $full_check        = $Is_Win32 ? 0 : $wanted->{follow};
-    $follow            = $Is_Win32 ? 0 :
-                             $full_check || $wanted->{follow_fast};
+    $full_check        = $wanted->{follow};
+    $follow            = $full_check || $wanted->{follow_fast};
     $follow_skip       = $wanted->{follow_skip};
     $untaint           = $wanted->{untaint};
     $untaint_pat       = $wanted->{untaint_pattern};
index 37ba6d5..add20c2 100644 (file)
@@ -34,6 +34,7 @@ use Testing qw(
     dir_path
     file_path
 );
+use Errno ();
 
 my %Expect_File = (); # what we expect for $_
 my %Expect_Name = (); # what we expect for $File::Find::name/fullname
@@ -247,7 +248,17 @@ create_file_ok( file_path('fb', $testing_basenames[0]) );
 mkdir_ok( dir_path('fb', 'fba'), 0770  );
 create_file_ok( file_path('fb', 'fba', $testing_basenames[1]) );
 if ($symlink_exists) {
-    symlink_ok('../fb','fa/fsl');
+    if (symlink('../fb','fa/fsl')) {
+        pass("able to symlink from ../fb to fa/fsl");
+    }
+    else {
+        if ($^O eq "MSWin32" && ($! == &Errno::ENOSYS || $! == &Errno::EPERM)) {
+            $symlink_exists = 0;
+        }
+        else {
+            fail("able to symlink from ../fb to fa/fsl");
+        }
+    }
 }
 create_file_ok( file_path('fa', $testing_basenames[2]) );
 
@@ -880,6 +891,7 @@ if ($^O eq 'MSWin32') {
                    dir_path('fb') => 1,
                    dir_path('fba') => 1);
 
+    $FastFileTests_OK = 0;
     File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa'));
     is( scalar(keys %Expect_File), 0, "Got no files, as expected" );
 
index c638ce0..056e06c 100644 (file)
@@ -28,7 +28,7 @@ sub mkdir_ok($$;$) {
     my ($dir, $mask) = @_[0..1];
     my $msg = $_[2] || "able to mkdir: $dir";
     ok( mkdir($dir, $mask), $msg )
-        or die("Unable to mkdir: $dir");
+        or die("Unable to mkdir $!: $dir");
 }
 
 sub symlink_ok($$;$) {
index f56d186..aed431a 100644 (file)
@@ -1,5 +1,24 @@
 #!./perl -T
 use strict;
+
+BEGIN {
+    require File::Spec;
+    if ($ENV{PERL_CORE}) {
+        # May be doing dynamic loading while @INC is all relative
+        @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC;
+    }
+
+    if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') {
+        # This is a hack - at present File::Find does not produce native names
+        # on Win32 or VMS, so force File::Spec to use Unix names.
+        # must be set *before* importing File::Find
+        require File::Spec::Unix;
+        @File::Spec::ISA = 'File::Spec::Unix';
+    }
+    require File::Find;
+    import File::Find;
+}
+
 use Test::More;
 BEGIN {
     plan(
@@ -16,6 +35,7 @@ use Testing qw(
     dir_path
     file_path
 );
+use Errno ();
 
 my %Expect_File = (); # what we expect for $_
 my %Expect_Name = (); # what we expect for $File::Find::name/fullname
@@ -169,8 +189,21 @@ create_file_ok( file_path('fb_taint', 'fb_ord') );
 mkdir_ok( dir_path('fb_taint', 'fba'), 0770  );
 create_file_ok( file_path('fb_taint', 'fba', 'fba_ord') );
 SKIP: {
-       skip "Creating symlink", 1, unless $symlink_exists;
-       ok( symlink('../fb_taint','fa_taint/fsl'), 'Created symbolic link' );
+    skip "Creating symlink", 1, unless $symlink_exists;
+    if (symlink('../fb_taint','fa_taint/fsl')) {
+        pass('Created symbolic link' );
+    }
+    else {
+        my $error = 0 + $!;
+        if ($^O eq "MSWin32" &&
+            ($error == &Errno::ENOSYS || $error == &Errno::EPERM)) {
+            $symlink_exists = 0;
+            skip "symbolic links not available", 1;
+        }
+        else {
+            fail('Created symbolic link');
+        }
+    }
 }
 create_file_ok( file_path('fa_taint', 'fa_ord') );
 
@@ -201,7 +234,8 @@ delete @Expect_Dir{ dir_path('fb_taint'), dir_path('fba') } unless $symlink_exis
 File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
                   untaint_pattern => qr|^(.+)$|}, topdir('fa_taint') );
 
-is(scalar keys %Expect_File, 0, 'Found all expected files');
+is(scalar keys %Expect_File, 0, 'Found all expected files')
+    or diag "Not found " . join(" ", sort keys %Expect_File);
 
 # don't untaint at all, should die
 %Expect_File = ();