If stdin, stdout or stderr get opened in unexpected read/write state

then warn at time of open not at time of use.

p4raw-id: //depot/perlio@9295

diff --git a/doio.c b/doio.c
index 67fa665..5a5b889 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -463,6 +463,18 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
        goto say_false;
     }
+
+    if (ckWARN(WARN_IO)) {
+       if ((IoTYPE(io) == IoTYPE_RDONLY) &&
+           (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
+               Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input",
+                               (fp == PerlIO_stdout()) ? "out" : "err");
+       }
+       else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdout()) {
+               Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output");
+       }
+    }
+
     if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
        if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
            (void)PerlIO_close(fp);
@@ -938,9 +950,7 @@ Perl_do_eof(pTHX_ GV *gv)
 
     if (!io)
        return TRUE;
-    else if (ckWARN(WARN_IO)
-            && (IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
-                || IoIFP(io) == PerlIO_stderr()))
+    else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY))
     {
        /* integrate to report_evil_fh()? */
         char *name = NULL;

diff --git a/pp_hot.c b/pp_hot.c
index 711b560..58874a8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -346,7 +346,7 @@ PP(pp_add)
        A side effect is that this also aggressively prefers integer maths over
        fp maths for integer values.
 
-       How to detect overflow? 
+       How to detect overflow?
 
        C 99 section 6.2.6.1 says
 
@@ -417,7 +417,7 @@ PP(pp_add)
            UV result;
            register UV buv;
            bool buvok = SvUOK(TOPs);
-           
+       
            if (buvok)
                buv = SvUVX(TOPs);
            else {
@@ -1459,10 +1459,9 @@ Perl_do_readline(pTHX)
        }
        else if (type == OP_GLOB)
            SP--;
-       else if (ckWARN(WARN_IO)        /* stdout/stderr or other write fh */
-                && (IoTYPE(io) == IoTYPE_WRONLY || fp == PerlIO_stdout()
-                    || fp == PerlIO_stderr()))
+       else if (ckWARN(WARN_IO) && IoTYPE(io) == IoTYPE_WRONLY) {
            report_evil_fh(PL_last_in_gv, io, OP_phoney_OUTPUT_ONLY);
+       }
     }
     if (!fp) {
        if (ckWARN2(WARN_GLOB, WARN_CLOSED)

diff --git a/pp_sys.c b/pp_sys.c
index ab43036..dc070f8 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1634,8 +1634,7 @@ PP(pp_sysread)
            count = -1;
     }
     if (count < 0) {
-       if ((IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
-           || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
+       if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
        {
            /* integrate with report_evil_fh()? */
            char *name = NULL;