set $! when statting a closed filehandle

When a stat fails because it's on a closed or otherwise invalid
filehandle, $! was often not being set, depending on the operation
and the nature of the invalidity.  Consistently set it to EBADF.
Fixes [perl #108288].

diff --git a/MANIFEST b/MANIFEST
index add651c..ac54b47 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5764,6 +5764,7 @@ t/op/sselect.t                    See if 4 argument select works
 t/op/stash.t                   See if %:: stashes work
 t/op/stash_parse_gv.t          See if parse_gv_stash_name works
 t/op/stat.t                    See if stat works
+t/op/stat_errors.t             See if stat and file tests handle threshold errors
 t/op/state.t                   See if state variables work
 t/op/study.t                   See if study works
 t/op/studytied.t               See if study works with tied scalars

diff --git a/doio.c b/doio.c
index 9aba9dc..7dcbbb5 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1779,8 +1779,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
     if (PL_op->op_flags & OPf_REF) {
        gv = cGVOP_gv;
       do_fstat:
-        if (gv == PL_defgv)
+        if (gv == PL_defgv) {
+           if (PL_laststatval < 0)
+               SETERRNO(EBADF,RMS_IFI);
             return PL_laststatval;
+       }
        io = GvIO(gv);
         do_fstat_have_io:
         PL_laststype = OP_STAT;
@@ -1791,6 +1794,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
                 int fd = PerlIO_fileno(IoIFP(io));
                 if (fd < 0) {
                     /* E.g. PerlIO::scalar has no real fd. */
+                   SETERRNO(EBADF,RMS_IFI);
                     return (PL_laststatval = -1);
                 } else {
                     return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache));
@@ -1801,6 +1805,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
         }
        PL_laststatval = -1;
        report_evil_fh(gv);
+       SETERRNO(EBADF,RMS_IFI);
        return -1;
     }
     else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
@@ -1853,6 +1858,8 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
        if (cGVOP_gv == PL_defgv) {
            if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "%s", no_prev_lstat);
+           if (PL_laststatval < 0)
+               SETERRNO(EBADF,RMS_IFI);
            return PL_laststatval;
        }
        PL_laststatval = -1;
@@ -1862,6 +1869,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
                              "Use of -l on filehandle %" HEKf,
                              HEKfARG(GvENAME_HEK(cGVOP_gv)));
        }
+       SETERRNO(EBADF,RMS_IFI);
        return -1;
     }
     if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))

diff --git a/pp_sys.c b/pp_sys.c
index 7cc19de..a1ea8f5 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2915,10 +2915,11 @@ PP(pp_stat)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
 
-       if (gv != PL_defgv) {
-           bool havefp;
+       if (gv == PL_defgv) {
+           if (PL_laststatval < 0)
+               SETERRNO(EBADF,RMS_IFI);
+       } else {
           do_fstat_have_io:
-           havefp = FALSE;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
             SvPVCLEAR(PL_statname);
@@ -2929,22 +2930,25 @@ PP(pp_stat)
                     if (IoIFP(io)) {
                         int fd = PerlIO_fileno(IoIFP(io));
                         if (fd < 0) {
+                           report_evil_fh(gv);
                             PL_laststatval = -1;
                             SETERRNO(EBADF,RMS_IFI);
                         } else {
                             PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
-                            havefp = TRUE;
                         }
                     } else if (IoDIRP(io)) {
                         PL_laststatval =
                             PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
-                        havefp = TRUE;
                     } else {
+                       report_evil_fh(gv);
                         PL_laststatval = -1;
+                       SETERRNO(EBADF,RMS_IFI);
                     }
-            }
-           else PL_laststatval = -1;
-           if (PL_laststatval < 0 && !havefp) report_evil_fh(gv);
+            } else {
+               report_evil_fh(gv);
+               PL_laststatval = -1;
+               SETERRNO(EBADF,RMS_IFI);
+           }
         }
 
        if (PL_laststatval < 0) {
@@ -3489,7 +3493,7 @@ PP(pp_fttty)
     else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX)
         fd = (int)uv;
     else
-       FT_RETURNUNDEF;
+       fd = -1;
     if (fd < 0) {
         SETERRNO(EBADF,RMS_IFI);
        FT_RETURNUNDEF;

diff --git a/t/op/stat_errors.t b/t/op/stat_errors.t
new file mode 100644 (file)
index 0000000..e043c61
--- /dev/null
+++ b/t/op/stat_errors.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+}
+
+plan(tests => 2*11*29);
+
+use Errno qw(EBADF ENOENT);
+
+open(SCALARFILE, "<", \"wibble") or die $!;
+open(CLOSEDFILE, "<", "./test.pl") or die $!;
+close(CLOSEDFILE) or die $!;
+opendir(CLOSEDDIR, "../lib") or die $!;
+closedir(CLOSEDDIR) or die $!;
+
+foreach my $op (
+    qw(stat lstat),
+    (map { "-$_" } qw(r w x o R W X O e z s f d l p S b c t u g k T B M A C)),
+) {
+    foreach my $arg (
+       (map { ($_, "\\*$_") }
+           qw(NEVEROPENED SCALARFILE CLOSEDFILE CLOSEDDIR _)),
+       "\"tmpnotexist\"",
+    ) {
+       my $argdesc = $arg;
+       if ($arg eq "_") {
+           my @z = lstat "tmpnotexist";
+           $argdesc .= " with prior stat fail";
+       }
+       SKIP: {
+           if ($op eq "-l" && $arg =~ /\A\\/) {
+               # The op weirdly stringifies the globref and uses it as
+               # a filename, rather than treating it as a file handle.
+               # That might be a bug, but while that behaviour exists it
+               # needs to be exempted from these tests.
+               skip "-l on globref", 2;
+           }
+           if ($op eq "-t" && $arg eq "\"tmpnotexist\"") {
+               # The op doesn't operate on filenames.
+               skip "-t on filename", 2;
+           }
+           $! = 0;
+           my $res = eval "$op $arg";
+           my $err = $!;
+           is $res, $op =~ /\A-/ ? undef : !!0, "result of $op $arg";
+           is 0+$err,
+               $arg eq "\"tmpnotexist\"" ||
+                   ($op =~ /\A-[TB]\z/ && $arg =~ /_\z/) ? ENOENT : EBADF,
+               "error from $op $arg";
+       }
+    }
+}
+
+1;