ExtUtils-Install/t/Install.t: better -w tests

I recently added some tests to Install.t to check that files weren't
writeable. I used "-w $file", which gives a false positive if run as
root. So this commit changes the test to do a stat then test (mode & 0200);
hopefully that emulation on non-POSIX platforms is good enough for this to
be a valid test. perlport makes no mention of what stat->mode contains
on non-POSIX platforms.

(Chris fixed this this with 84d7dacc0cf1f by skipping the test if running
as root, but the current commit is more robust, in that is still tests for
correctness under root.)

diff --git a/dist/ExtUtils-Install/lib/ExtUtils/Install.pm b/dist/ExtUtils-Install/lib/ExtUtils/Install.pm
index 67981ac..f9b455f 100644 (file)
--- a/dist/ExtUtils-Install/lib/ExtUtils/Install.pm
+++ b/dist/ExtUtils-Install/lib/ExtUtils/Install.pm
@@ -42,7 +42,7 @@ ExtUtils::Install - install files from here to there
 
 =cut
 
 
 =cut
 

-$VERSION = '1.66';  # <-- do not forget to update the POD section just above this line!
+$VERSION = '1.67';  # <-- do not forget to update the POD section just above this line!

 $VERSION = eval $VERSION;
 
 =pod
 $VERSION = eval $VERSION;
 
 =pod

diff --git a/dist/ExtUtils-Install/t/Install.t b/dist/ExtUtils-Install/t/Install.t
index e45e1dd..f6af4a7 100644 (file)
--- a/dist/ExtUtils-Install/t/Install.t
+++ b/dist/ExtUtils-Install/t/Install.t
@@ -192,6 +192,17 @@ close DUMMY;
 }
 
 
 }
 
 

+# do a -w style test, but based on just on file perms rather than UID
+# (on UNIX, root sees everything as writeable)
+
+sub writeable {
+    my ($file) = @_;
+    my @stat = stat $file;
+    return 0 unless defined $stat[2]; # mode
+    return $stat[2] & 0200;
+}
+
+

 # really this test should be run on any platform that supports
 # symbolic and hard links, but this representative sample should do for
 # now
 # really this test should be run on any platform that supports
 # symbolic and hard links, but this representative sample should do for
 # now


@@ -226,10 +237,7 @@ SKIP: {
                          },
     ]);
 
                          },
     ]);
 

-    SKIP: {
-      skip 'everywhere is writable to root', 1 if $> == 0;
-      ok( !-w "$bigdir/DummyHard.pm", 'DummyHard.pm not writeable' );
-    }
+    ok( !writeable("$bigdir/DummyHard.pm"), 'DummyHard.pm not writeable' );

 
     use File::Compare;
     ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyHard.pm"),
 
     use File::Compare;
     ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyHard.pm"),


@@ -253,10 +261,7 @@ SKIP: {
                          },
     ]);
 
                          },
     ]);
 

-    SKIP: {
-      skip 'everywhere is writable to root', 1 if $> == 0;
-      ok( !-w "$bigdir/DummyOrig.pm", 'DummyOrig.pm not writeable' );
-    }
+    ok( !writeable("$bigdir/DummyOrig.pm"), 'DummyOrig.pm not writeable' );

     ok( !-l "$bigdir/Dummy.pm", 'Dummy.pm not a link' );
     ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyOrig.pm"),
         "orig file should be different");
     ok( !-l "$bigdir/Dummy.pm", 'Dummy.pm not a link' );
     ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyOrig.pm"),
         "orig file should be different");