This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip suid File::Copy tests on a nosuid partition
authorÆvar Arnfjörð Bjarmason <avar@cpan.org>
Thu, 13 May 2010 20:05:35 +0000 (20:05 +0000)
committerSteffen Mueller <smueller@cpan.org>
Sat, 3 Jul 2010 13:23:37 +0000 (15:23 +0200)
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.

lib/File/Copy.t

index b6e4a19..63c99d1 100644 (file)
@@ -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