RT 79076: fix File::stat overload tests -x and -X when uid is root
authorTodd Rinaldo <toddr@cpan.org>
Thu, 11 Nov 2010 23:08:34 +0000 (17:08 -0600)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 12 Nov 2010 02:08:46 +0000 (18:08 -0800)
lib/File/stat.pm
lib/File/stat.t

index a783e08..d403033 100644 (file)
@@ -84,7 +84,9 @@ else {
         my ($s, $mode, $eff) = @_;
         my $uid = $eff ? $> : $<;
 
-        $^O ne "VMS" and $uid == 0  and return 1;
+        # If we're root on unix and we are not testing for exectable
+        # status, then all file tests are true.
+        $^O ne "VMS" and $uid == 0 and !($mode & 0111) and return 1;
 
         my ($stmode, $stuid, $stgid) = @$s[2,4,5];
 
index afeb446..40bd86b 100644 (file)
@@ -21,7 +21,7 @@ BEGIN {
     our $file = '../lib/File/stat.t';
     if ( $Dmksymlinks ) {
         $file = readlink $file;
-        die "Can't readlink(TEST): $!" if ! defined $file;
+        die "Can't readlink(../lib/File/stat.t): $!" if ! defined $file;
     }
 
     our $hasst;
@@ -42,7 +42,7 @@ BEGIN {
 our @stat = stat $file; # This is the function stat.
 unless (@stat) { plan skip_all => "1..0 # Skip: no file $file"; exit 0 }
 
-plan tests => 19 + 24*2 + 3;
+plan tests => 19 + 24*2 + 4 + 3;
 
 use_ok( 'File::stat' );
 
@@ -91,6 +91,21 @@ for (split //, "rwxoRWXOezsfdlpSbcugkMCA") {
     }
 }
 
+SKIP: {
+    my $file = '../perl';
+    -e $file && -x $file or skip "$file is not present and exectable", 4;
+    $^O eq "VMS" and skip "File::stat ignores VMS ACLs", 4;
+
+    my $stat = File::stat::stat( $file ); # This is the OO stat.
+    foreach (qw/x X/) {
+    my $rv = eval "-$_ \$stat";
+    ok( !$@,                            "-$_ overload succeeds" )
+      or diag( $@ );
+    is( $rv, eval "-$_ \$file",         "correct -$_ overload" );
+  }
+}
+
+
 for (split //, "tTB") {
     eval "-$_ \$stat";
     like( $@, qr/\Q-$_ is not implemented/, "-$_ overload fails" );