This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In t/op/filetest.t, simplify the logic for testing read-only files.
[perl5.git] / t / op / filetest.t
index 7dda4f7..a3df1c0 100644 (file)
@@ -9,7 +9,6 @@ BEGIN {
     require './test.pl';
 }
 
     require './test.pl';
 }
 
-use Config;
 plan(tests => 47 + 27*14);
 
 ok( -d 'op' );
 plan(tests => 47 + 27*14);
 
 ok( -d 'op' );
@@ -28,23 +27,26 @@ my $ro_file = tempfile();
 
 chmod 0555, $ro_file or die "chmod 0555, '$ro_file' failed: $!";
 
 
 chmod 0555, $ro_file or die "chmod 0555, '$ro_file' failed: $!";
 
-$oldeuid = $>;         # root can read and write anything
-eval '$> = 1';         # so switch uid (may not be implemented)
-
-print "# oldeuid = $oldeuid, euid = $>\n";
-
 SKIP: {
 SKIP: {
-    if (!$Config{d_seteuid}) {
-       skip('no seteuid');
-    } 
-    else {
-       ok( !-w $ro_file );
+    my $restore_root;
+    if ($> == 0) {
+       # root can read and write anything, so switch uid (may not be
+       # implemented)
+       eval '$> = 1';
+
+       skip("Can't drop root privs to test read-only files") if $> == 0;
+       note("Dropped root privs to test read-only files. \$> == $>");
+       ++$restore_root;
     }
     }
-}
 
 
-# Scripts are not -x everywhere so cannot test that.
+    ok( !-w $ro_file );
 
 
-eval '$> = $oldeuid';  # switch uid back (may not be implemented)
+    if ($restore_root) {
+       # If the previous assignment to $> worked, so should this:
+       $> = 0;
+       note("Restored root privs after testing read-only files. \$> == $>");
+    }
+}
 
 # these would fail for the euid 1
 # (unless we have unpacked the source code as uid 1...)
 
 # these would fail for the euid 1
 # (unless we have unpacked the source code as uid 1...)