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

3 files changed, 18 insertions, 10 deletions

diff --git a/doio.c b/doio.c
index 67fa665806..5a5b889f5d 100644
--- 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 711b560b8b..58874a87b9 100644
--- 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 ab430367fa..dc070f81b9 100644
--- 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;