summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2023-02-09 17:57:33 +0100
committerℕicolas ℝ <nicolas@atoomic.org>2023-02-09 21:31:19 -0700
commit5d4d8b9fa5103e3bd911bb1ab9e94eb6d8e0ff28 (patch)
tree6388fa6153e3187c17cb74b87e71a264f86e26a7 /ext
parent8ab54e77a59c2f25aff25440e4592404cc8d8d72 (diff)
downloadperl-5d4d8b9fa5103e3bd911bb1ab9e94eb6d8e0ff28.tar.gz
File-Find - set up tempdir early and test that we can chdir to it.
If for some reason we die very early in the test script the cleanup() function would get called before we had set up $test_root_dir or $test_temp_dir. This then lead to further errors being generated by trying to chdir into an undefined directory. This patch ensures that the various setup behavior worked correctly, and that if it does not that we have some clear diagnostics about it.
Diffstat (limited to 'ext')
-rw-r--r--ext/File-Find/lib/File/Find.pm2
-rw-r--r--ext/File-Find/t/find.t46
-rw-r--r--ext/File-Find/t/lib/Testing.pm41
-rw-r--r--ext/File-Find/t/taint.t39
4 files changed, 93 insertions, 35 deletions
diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm
index dd08d67f18..a41a6f5a56 100644
--- a/ext/File-Find/lib/File/Find.pm
+++ b/ext/File-Find/lib/File/Find.pm
@@ -3,7 +3,7 @@ use 5.006;
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.42';
+our $VERSION = '1.43';
use Exporter 'import';
require Cwd;
diff --git a/ext/File-Find/t/find.t b/ext/File-Find/t/find.t
index 953fa8746d..b6359d86ae 100644
--- a/ext/File-Find/t/find.t
+++ b/ext/File-Find/t/find.t
@@ -33,6 +33,7 @@ use Testing qw(
symlink_ok
dir_path
file_path
+ _cleanup_start
);
use Errno ();
use File::Temp qw(tempdir);
@@ -42,7 +43,11 @@ my %Expect_Name = (); # what we expect for $File::Find::name/fullname
my %Expect_Dir = (); # what we expect for $File::Find::dir
my (@files);
-my $orig_dir = cwd();
+my $test_root_dir = cwd();
+ok($test_root_dir,"We were able to determine our starting directory");
+my $test_temp_dir = tempdir("FF_find_t_XXXXXX",CLEANUP=>1);
+ok($test_temp_dir,"We were able to set up a temp directory");
+
# Uncomment this to see where File::Find is chdir-ing to. Helpful for
# debugging its little jaunts around the filesystem.
@@ -72,31 +77,34 @@ my $orig_dir = cwd();
}
# Do find() and finddepth() work correctly in the directory
-# from which we start? (Test presumes the presence of 'taint.t' in same
+# from which we start? (Test presumes the presence of 'find.t' in same
# directory as this test file.)
-$::count_taint = 0;
-find({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } },
+my $count_found = 0;
+find({wanted => sub { ++$count_found if $_ eq 'find.t'; } },
File::Spec->curdir);
-is($::count_taint, 1, "'find' found exactly 1 file named 'taint.t'");
+is($count_found, 1, "'find' found exactly 1 file named 'find.t'");
-$::count_taint = 0;
-finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } },
+$count_found = 0;
+finddepth({wanted => sub { ++$count_found if $_ eq 'find.t'; } },
File::Spec->curdir);
-is($::count_taint, 1, "'finddepth' found exactly 1 file named 'taint.t'");
+is($count_found, 1, "'finddepth' found exactly 1 file named 'find.t'");
my $FastFileTests_OK = 0;
-my $test_root_dir = cwd();
-my $test_temp_dir = tempdir("FF_find_t_XXXXXX",CLEANUP=>1);
-chdir($test_temp_dir) or die "Failed to chdir to '$test_temp_dir': $!";
+my $chdir_error = "";
+chdir($test_temp_dir)
+ or $chdir_error = "Failed to chdir to '$test_temp_dir': $!";
+is($chdir_error,"","chdir to temp dir '$test_temp_dir' successful")
+ or die $chdir_error;
sub cleanup {
- # doing this in two steps avoids the need to know about
- # directory separators, which is helpful as we override
- # the File::Spec heirarchy, so we can't ask it to help us here.
- chdir($test_root_dir) or die "Failed to chdir to '$test_root_dir': $!";
- chdir($test_temp_dir) or die "Failed to chdir to '$test_temp_dir': $!";
+ # the following chdirs into $test_root_dir/$test_temp_dir but
+ # handles various possible edge case errors cleanly. If it returns
+ # false then we bail out of the cleanup.
+ _cleanup_start($test_root_dir, $test_temp_dir)
+ or return;
+
my $need_updir = 0;
if (-d dir_path('for_find')) {
$need_updir = 1 if chdir(dir_path('for_find'));
@@ -872,7 +880,7 @@ if ( $symlink_exists ) {
if ($^O eq 'MSWin32') {
require File::Spec::Win32;
- my ($volume) = File::Spec::Win32->splitpath($orig_dir, 1);
+ my ($volume) = File::Spec::Win32->splitpath($test_root_dir, 1);
print STDERR "VOLUME = $volume\n";
##### #####
@@ -1030,7 +1038,7 @@ 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";
+ $test_root_dir =~ /^(\w:)/ or die "expected a drive: $test_root_dir";
my $drive = $1;
# Determine the file in the root directory which would be
@@ -1057,7 +1065,7 @@ if ($^O eq 'MSWin32') {
# 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;
+ local $ENV{HOME} = $test_root_dir;
foreach my $no_chdir (0, 1) {
foreach my $root_dir ("/", "\\", "$drive/", "$drive\\") {
eval {
diff --git a/ext/File-Find/t/lib/Testing.pm b/ext/File-Find/t/lib/Testing.pm
index 8282bcf427..c7638e8864 100644
--- a/ext/File-Find/t/lib/Testing.pm
+++ b/ext/File-Find/t/lib/Testing.pm
@@ -9,6 +9,7 @@ our @EXPORT_OK = qw(
symlink_ok
dir_path
file_path
+ _cleanup_start
);
# Wrappers around Test::More::ok() for creation of files, directories and
@@ -96,4 +97,44 @@ sub file_path {
}
}
+sub _something_wrong {
+ my ($message) = @_;
+ warn "in cleanup: $message\n" .
+ "Something seems to be very wrong. Possibly the directory\n" .
+ "we are testing in has been removed or wiped while we ran?\n";
+ return 0;
+}
+
+sub _cleanup_start {
+ my ($test_root_dir, $test_temp_dir)= @_;
+
+ # doing the following two chdirs (and their validation) in two
+ # distinct steps avoids the need to know about directory separators,
+ # or other FS specifics, which is helpful as the test files that use
+ # this function overrides the File::Spec heirarchy, so we can't ask it
+ # to help us here.
+
+ # chdir into the $test_root_dir to start the cleanup. But first validate.
+ if (!$test_root_dir) {
+ return _something_wrong("No test_root_dir?");
+ }
+ if (!-d $test_root_dir) {
+ return _something_wrong("test_root_dir '$test_root_dir' seems to have disappeared!");
+ }
+ chdir($test_root_dir)
+ or return _something_wrong("Failed to chdir to '$test_root_dir': $!");
+
+ # chdir into the $test_temp_dir to start the cleanup. But first validate.
+ if (!$test_temp_dir) {
+ return _something_wrong("No test_temp_dir?");
+ }
+ if (!-d $test_temp_dir) {
+ return _something_wrong("test_temp_dir '$test_temp_dir' seems to have disappeared!");
+ }
+ chdir($test_temp_dir)
+ or return _wrong("Failed to chdir to '$test_temp_dir': $!");
+
+ return 1;
+}
+
1;
diff --git a/ext/File-Find/t/taint.t b/ext/File-Find/t/taint.t
index 23359100b6..2500b53819 100644
--- a/ext/File-Find/t/taint.t
+++ b/ext/File-Find/t/taint.t
@@ -28,6 +28,7 @@ use Testing qw(
symlink_ok
dir_path
file_path
+ _cleanup_start
);
use Errno ();
use Config;
@@ -36,7 +37,7 @@ use File::Temp qw(tempdir);
BEGIN {
plan(
${^TAINT}
- ? (tests => 45)
+ ? (tests => 48)
: (skip_all => "A perl without taint support")
);
}
@@ -72,6 +73,17 @@ BEGIN {
my $symlink_exists = eval { symlink("",""); 1 };
+my $test_root_dir; # where we are when this test starts
+my $test_root_dir_tainted = cwd();
+if ($test_root_dir_tainted =~ /^(.*)$/) {
+ $test_root_dir = $1;
+} else {
+ die "Failed to untaint root dir of test";
+}
+ok($test_root_dir,"test_root_dir is set up as expected");
+my $test_temp_dir = tempdir("FF_taint_t_XXXXXX",CLEANUP=>1);
+ok($test_temp_dir,"test_temp_dir is set up as expected");
+
my $found;
find({wanted => sub { ++$found if $_ eq 'taint.t' },
untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
@@ -87,22 +99,19 @@ is($found, 1, 'taint.t found once again');
my $case = 2;
my $FastFileTests_OK = 0;
-my $test_root_dir; # where we are when this test starts
-my $test_root_dir_tainted = cwd();
-if ($test_root_dir_tainted =~ /^(.*)$/) {
- $test_root_dir = $1;
-} else {
- die "Failed to untaint root dir of test";
-}
-my $test_temp_dir = tempdir("FF_taint_t_XXXXXX",CLEANUP=>1);
-chdir($test_temp_dir) or die "Failed to chdir to '$test_temp_dir': $!";
+my $chdir_error = "";
+chdir($test_temp_dir)
+ or $chdir_error = "Failed to chdir to '$test_temp_dir': $!";
+is($chdir_error,"","chdir to temp dir '$test_temp_dir' successful")
+ or die $chdir_error;
sub cleanup {
- # doing this in two steps avoids the need to know about
- # directory separators, which is helpful as we override
- # the File::Spec heirarchy, so we can't ask it to help us here.
- chdir($test_root_dir) or die "Failed to chdir to '$test_root_dir': $!";
- chdir($test_temp_dir) or die "Failed to chdir to '$test_temp_dir': $!";
+ # the following chdirs into $test_root_dir/$test_temp_dir but
+ # handles various possible edge case errors cleanly. If it returns
+ # false then we bail out of the cleanup.
+ _cleanup_start($test_root_dir, $test_temp_dir)
+ or return;
+
my $need_updir = 0;
if (-d dir_path('for_find_taint')) {
$need_updir = 1 if chdir(dir_path('for_find_taint'));