Allow stat() and -X file tests work on dirhandles.

p4raw-id: //depot/perl@28473

diff --git a/doio.c b/doio.c
index 41f026f..25756ab 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1308,22 +1308,31 @@ Perl_my_stat(pTHX)
        EXTEND(SP,1);
        gv = cGVOP_gv;
       do_fstat:
+        if (gv == PL_defgv)
+            return PL_laststatval;
        io = GvIO(gv);
-       if (io && IoIFP(io)) {
-           PL_statgv = gv;
-           sv_setpvn(PL_statname,"", 0);
-           PL_laststype = OP_STAT;
-           return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
-       }
-       else {
-           if (gv == PL_defgv)
-               return PL_laststatval;
-           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-               report_evil_fh(gv, io, PL_op->op_type);
-           PL_statgv = NULL;
-           sv_setpvn(PL_statname,"", 0);
-           return (PL_laststatval = -1);
-       }
+        PL_laststype = OP_STAT;
+        PL_statgv = gv;
+        sv_setpvn(PL_statname, "", 0);
+        if(io) {
+           if (IoIFP(io)) {
+               return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
+            } else if (IoDIRP(io)) {
+#ifdef HAS_DIRFD
+                return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache));
+#else
+                DIE(aTHX_ PL_no_func, "dirfd");
+#endif
+            } else {
+                if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                    report_evil_fh(gv, io, PL_op->op_type);
+                return (PL_laststatval = -1);
+            }
+       } else {
+            if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                report_evil_fh(gv, io, PL_op->op_type);
+            return (PL_laststatval = -1);
+        }
     }
     else if (PL_op->op_private & OPpFT_STACKED) {
        return PL_laststatval;

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 26907b9..41f19a8 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -281,11 +281,13 @@ X<-S>X<-b>X<-c>X<-t>X<-u>X<-g>X<-k>X<-T>X<-B>X<-M>X<-A>X<-C>
 
 =item -X EXPR
 
+=item -X DIRHANDLE
+
 =item -X
 
 A file test, where X is one of the letters listed below.  This unary
-operator takes one argument, either a filename or a filehandle, and
-tests the associated file to see if something is true about it.  If the
+operator takes one argument, either a filename, a filehandle, or a dirhandle, 
+and tests the associated file to see if something is true about it.  If the
 argument is omitted, tests C<$_>, except for C<-t>, which tests STDIN.
 Unless otherwise documented, it returns C<1> for true and C<''> for false, or
 the undefined value if the file doesn't exist.  Despite the funny
@@ -5827,12 +5829,14 @@ X<stat> X<file, status>
 
 =item stat EXPR
 
+=item stat DIRHANDLE
+
 =item stat
 
 Returns a 13-element list giving the status info for a file, either
-the file opened via FILEHANDLE, or named by EXPR.  If EXPR is omitted,
-it stats C<$_>.  Returns a null list if the stat fails.  Typically used
-as follows:
+the file opened via FILEHANDLE or DIRHANDLE, or named by EXPR.  If EXPR is 
+omitted, it stats C<$_>.  Returns a null list if the stat fails.  Typically
+used as follows:
 
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks)

diff --git a/pp_sys.c b/pp_sys.c
index 0c3d6de..25deca1 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2790,9 +2790,26 @@ PP(pp_stat)
            PL_laststype = OP_STAT;
            PL_statgv = gv;
            sv_setpvn(PL_statname, "", 0);
-           PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
-               ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
-       }
+            if(gv) {
+                IO* const io = GvIO(gv);
+                if (io) {
+                    if (IoIFP(io)) {
+                        PL_laststatval = 
+                            PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
+                    } else if (IoDIRP(io)) {
+#ifdef HAS_DIRFD
+                        PL_laststatval =
+                            PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache);
+#else
+                        DIE(aTHX_ PL_no_func, "dirfd");
+#endif
+                    } else {
+                        PL_laststatval = -1;
+                    }
+               }
+            }
+        }
+
        if (PL_laststatval < 0) {
            if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
                report_evil_fh(gv, GvIO(gv), PL_op->op_type);

diff --git a/t/op/stat.t b/t/op/stat.t
index c2d3731..dac326a 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -9,7 +9,7 @@ BEGIN {
 use Config;
 use File::Spec;
 
-plan tests => 86;
+plan tests => 88;
 
 my $Perl = which_perl();
 
@@ -479,6 +479,13 @@ ok(unlink($f), 'unlink tmp file');
     unlink $tmpfile;
 }
 
+SKIP: {
+    skip "No dirfd()", 2 unless $Config{d_dirfd};
+    opendir my $dir, "." or die 'Unable to opendir ".":  $!';
+    ok(stat($dir), "stat() on dirhandle works"); 
+    ok(-d -r _ , "chained -x's on dirhandle"); 
+}
+
 END {
     1 while unlink $tmpfile;
 }