diff options
author | Ævar Arnfjörð Bjarmason <avar@cpan.org> | 2010-05-13 20:05:35 +0000 |
---|---|---|
committer | Steffen Mueller <smueller@cpan.org> | 2010-07-03 15:23:37 +0200 |
commit | cae9400fee55b7e628d974f47e5bbebb4180a9c2 (patch) | |
tree | ba058d71d3cec9727a043c17cceaa09be07282d8 /lib/File | |
parent | e07ce2e4e82e3054dc912dbe99348744647bf30b (diff) | |
download | perl-cae9400fee55b7e628d974f47e5bbebb4180a9c2.tar.gz |
Skip suid File::Copy tests on a nosuid partition
These tests were being skipped on OpenBSD, but nosuid partitions can
exist on other systems too. Now it just checks if it can create a suid
directory, if not the tests are skipped.
Perl builds without errors in a nosuid /tmp with this patch.
Diffstat (limited to 'lib/File')
-rw-r--r-- | lib/File/Copy.t | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/lib/File/Copy.t b/lib/File/Copy.t index b6e4a19666..63c99d1261 100644 --- a/lib/File/Copy.t +++ b/lib/File/Copy.t @@ -237,6 +237,14 @@ for my $cross_partition_test (0..1) { } } +my $can_suidp = sub { + my $dir = "suid-$$"; + my $ok = 1; + mkdir $dir or die "Can't mkdir($dir) for suid test"; + $ok = 0 unless chmod 2000, $dir; + rmdir $dir; + return $ok; +}; SKIP: { my @tests = ( @@ -251,9 +259,8 @@ SKIP: { my $skips = @tests * 6 * 8; - # TODO - make this skip fire if we're on a nosuid filesystem rather than guessing by OS - skip "OpenBSD filesystems default to nosuid breaking these tests", $skips - if $^O eq 'openbsd'; + my $can_suid = $can_suidp->(); + skip "Can't suid on this $^O filesystem", $skips unless $can_suid; skip "-- Copy preserves RMS defaults, not POSIX permissions.", $skips if $^O eq 'VMS'; skip "Copy doesn't set file permissions correctly on Win32.", $skips |