better diagnostics on read operations from write-only

filehandles

p4raw-id: //depot/perl@3632

8 files changed, 117 insertions, 44 deletions

diff --git a/doio.c b/doio.c
index 7c093aedce..f6eb798ff7 100644
--- a/doio.c
+++ b/doio.c
@@ -706,6 +706,15 @@ Perl_do_eof(pTHX_ GV *gv)
 
     if (!io)
 	return TRUE;
+    else if (ckWARN(WARN_IO)
+	     && (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+		 || IoIFP(io) == PerlIO_stderr()))
+    {
+	SV* sv = sv_newmortal();
+	gv_efullname3(sv, gv, Nullch);
+	Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+		    SvPV_nolen(sv));
+    }
 
     while (IoIFP(io)) {
 
diff --git a/perl.c b/perl.c
index 062b33457c..1bd2346461 100644
--- a/perl.c
+++ b/perl.c
@@ -2604,29 +2604,33 @@ S_init_predump_symbols(pTHX)
     dTHR;
     GV *tmpgv;
     GV *othergv;
+    IO *io;
 
     sv_setpvn(get_sv("\"", TRUE), " ", 1);
     PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
-    IoIFP(GvIOp(PL_stdingv)) = PerlIO_stdin();
+    io = GvIOp(PL_stdingv);
+    IoIFP(io) = PerlIO_stdin();
     tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_stdingv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
     GvMULTI_on(tmpgv);
-    IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = PerlIO_stdout();
+    io = GvIOp(tmpgv);
+    IoOFP(io) = IoIFP(io) = PerlIO_stdout();
     setdefout(tmpgv);
     tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_defoutgv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
     GvMULTI_on(othergv);
-    IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = PerlIO_stderr();
+    io = GvIOp(othergv);
+    IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     PL_statname = NEWSV(66,0);		/* last filename we did stat on */
 
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 3284cf70da..be5366d116 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -229,6 +229,13 @@ was attempted.  This mostly eliminates confusing
 buffering mishaps suffered by users unaware of how Perl internally
 handles I/O.
 
+=head2 Better diagnostics on meaningless filehandle operations
+
+Constructs such as C<open(E<lt>FHE<gt>)> and C<close(E<lt>FHE<gt>)>
+are compile time errors.  Attempting to read from filehandles that
+were opened only for writing will now produce warnings (just as
+writing to read-only filehandles does).
+
 =head1 Supported Platforms
 
 =over 4
@@ -467,16 +474,24 @@ A tutorial on managing class data for object modules.
 by Perl.  This combination appears in an interpolated variable or a
 C<'>-delimited regular expression.
 
-=item Unrecognized escape \\%c passed through
+=item Filehandle %s opened only for output
 
-(W) You used a backslash-character combination which is not recognized
-by Perl.
+(W) You tried to read from a filehandle opened only for writing.  If you
+intended it to be a read-write filehandle, you needed to open it with
+"+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing.  If
+you intended only to read from the file, use "E<lt>".  See
+L<perlfunc/open>.
 
 =item Missing command in piped open
 
 (W) You used the C<open(FH, "| command")> or C<open(FH, "command |")>
 construction, but the command was missing or blank.
 
+=item Unrecognized escape \\%c passed through
+
+(W) You used a backslash-character combination which is not recognized
+by Perl.
+
 =item defined(@array) is deprecated
 
 (D) defined() is not usually useful on arrays because it checks for an
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index d7b9024998..45c7be1905 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1265,7 +1265,7 @@ PDP-11 or something?
 You need to do an open() or a socket() call, or call a constructor from
 the FileHandle package.
 
-=item Filehandle %s opened for only input
+=item Filehandle %s opened only for input
 
 (W) You tried to write on a read-only filehandle.  If you
 intended it to be a read-write filehandle, you needed to open it with
@@ -1273,12 +1273,12 @@ intended it to be a read-write filehandle, you needed to open it with
 you intended only to write the file, use "E<gt>" or "E<gt>E<gt>".  See
 L<perlfunc/open>.
 
-=item Filehandle opened for only input
+=item Filehandle %s opened only for output
 
-(W) You tried to write on a read-only filehandle.  If you
+(W) You tried to read from a filehandle opened only for writing.  If you
 intended it to be a read-write filehandle, you needed to open it with
 "+E<lt>" or "+E<gt>" or "+E<gt>E<gt>" instead of with "E<lt>" or nothing.  If
-you intended only to write the file, use "E<gt>" or "E<gt>E<gt>".  See
+you intended only to read from the file, use "E<lt>".  See
 L<perlfunc/open>.
 
 =item Final $ should be \$ or $name
@@ -2274,7 +2274,7 @@ are outside the range which can be represented by integers internally.
 One possible workaround is to force Perl to use magical string
 increment by prepending "0" to your numbers.
 
-=item Read on closed filehandle E<lt>%sE<gt>
+=item Read on closed filehandle %s
 
 (W) The filehandle you're reading from got itself closed sometime before now.
 Check your logic flow.
@@ -3169,7 +3169,7 @@ but in actual fact, you got
 
 So put in parentheses to say what you really mean.
 
-=item Write on closed filehandle
+=item Write on closed filehandle %s
 
 (W) The filehandle you're writing to got itself closed sometime before now.
 Check your logic flow.
diff --git a/pp_hot.c b/pp_hot.c
index 697c30697a..f5ba85aa6e 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -350,23 +350,24 @@ PP(pp_print)
     if (!(io = GvIO(gv))) {
 	if (ckWARN(WARN_UNOPENED)) {
 	    SV* sv = sv_newmortal();
-            gv_fullname3(sv, gv, Nullch);
-            Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
+	    gv_efullname3(sv, gv, Nullch);
+            Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened",
+			SvPV(sv,n_a));
         }
-
 	SETERRNO(EBADF,RMS$_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
 	if (ckWARN2(WARN_CLOSED, WARN_IO))  {
 	    SV* sv = sv_newmortal();
-            gv_fullname3(sv, gv, Nullch);
+	    gv_efullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", 
-				SvPV(sv,n_a));
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for input",
+			    SvPV(sv,n_a));
 	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED, "print on closed filehandle %s", 
-				SvPV(sv,n_a));
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "print on closed filehandle %s", SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -1228,15 +1229,29 @@ Perl_do_readline(pTHX)
 	}
 	else if (type == OP_GLOB)
 	    SP--;
+	else if (ckWARN(WARN_IO)	/* stdout/stderr or other write fh */
+		 && (IoTYPE(io) == '>' || fp == PerlIO_stdout()
+		     || fp == PerlIO_stderr()))
+	{
+	    SV* sv = sv_newmortal();
+	    gv_efullname3(sv, PL_last_in_gv, Nullch);
+	    Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+			SvPV_nolen(sv));
+	}
     }
     if (!fp) {
 	if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
 	    if (type == OP_GLOB)
-		Perl_warner(aTHX_ WARN_CLOSED, "glob failed (can't start child: %s)",
-		       Strerror(errno));
-	    else
-		Perl_warner(aTHX_ WARN_CLOSED, "Read on closed filehandle <%s>",
-		       GvENAME(PL_last_in_gv));
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "glob failed (can't start child: %s)",
+			    Strerror(errno));
+	    else {
+		SV* sv = sv_newmortal();
+		gv_efullname3(sv, PL_last_in_gv, Nullch);
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "Read on closed filehandle %s",
+			    SvPV_nolen(sv));
+	    }
 	}
 	if (gimme == G_SCALAR) {
 	    (void)SvOK_off(TARG);
diff --git a/pp_sys.c b/pp_sys.c
index a2ed109a4d..c608ab5d05 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1272,10 +1272,15 @@ PP(pp_leavewrite)
     fp = IoOFP(io);
     if (!fp) {
 	if (ckWARN2(WARN_CLOSED,WARN_IO)) {
+	    SV* sv = sv_newmortal();
+	    gv_efullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		Perl_warner(aTHX_ WARN_IO, "Filehandle only opened for input");
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for input",
+			    SvPV_nolen(sv));
 	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED, "Write on closed filehandle");
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "Write on closed filehandle %s", SvPV_nolen(sv));
 	}
 	PUSHs(&PL_sv_no);
     }
@@ -1339,21 +1344,23 @@ PP(pp_prtf)
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
 	if (ckWARN(WARN_UNOPENED)) {
-	    gv_fullname3(sv, gv, Nullch);
-	    Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,n_a));
+	    gv_efullname3(sv, gv, Nullch);
+	    Perl_warner(aTHX_ WARN_UNOPENED,
+			"Filehandle %s never opened", SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,RMS$_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
 	if (ckWARN2(WARN_CLOSED,WARN_IO))  {
-	    gv_fullname3(sv, gv, Nullch);
+	    gv_efullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input",
-			SvPV(sv,n_a));
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for input",
+			    SvPV(sv,n_a));
 	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED, "printf on closed filehandle %s",
-			SvPV(sv,n_a));
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "printf on closed filehandle %s", SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -1538,8 +1545,17 @@ PP(pp_sysread)
 	if (length == 0 && PerlIO_error(IoIFP(io)))
 	    length = -1;
     }
-    if (length < 0)
+    if (length < 0) {
+	if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+	    || IoIFP(io) == PerlIO_stderr())
+	{
+	    SV* sv = sv_newmortal();
+	    gv_efullname3(sv, gv, Nullch);
+	    Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+			SvPV_nolen(sv));
+	}
 	goto say_undef;
+    }
     SvCUR_set(bufsv, length+offset);
     *SvEND(bufsv) = '\0';
     (void)SvPOK_only(bufsv);
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index c78b2667e6..817c0c89d6 100644
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -6,6 +6,8 @@
   Filehandle %s opened only for input
     print STDIN "abc" ;
 
+  Filehandle %s opened only for output
+    print <STDOUT> ;
 
   print on closed filehandle %s
     close STDIN ; print STDIN "abc" ;
@@ -22,7 +24,7 @@
   Reference found where even-sized list expected 
 	$X = [ 1 ..3 ];
 
-  Read on closed filehandle <%s>
+  Read on closed filehandle %s
     close STDIN ; $a = <STDIN>;
 
   Deep recursion on subroutine \"%s\"
@@ -42,8 +44,20 @@ Filehandle main::abc never opened at - line 4.
 # pp_hot.c
 use warning 'io' ;
 print STDIN "anc";
+print <STDOUT>;
+print <STDERR>;
+open(FOO, ">&STDOUT") and print <FOO>;
+print getc(STDERR);
+print getc(FOO);
+read(FOO,$_,1);
 EXPECT
 Filehandle main::STDIN opened only for input at - line 3.
+Filehandle main::STDOUT opened only for output at - line 4.
+Filehandle main::STDERR opened only for output at - line 5.
+Filehandle main::FOO opened only for output at - line 6.
+Filehandle main::STDERR opened only for output at - line 7.
+Filehandle main::FOO opened only for output at - line 8.
+Filehandle main::FOO opened only for output at - line 9.
 ########
 # pp_hot.c
 use warning 'closed' ;
@@ -82,7 +96,7 @@ Reference found where even-sized list expected at - line 3.
 use warning 'closed' ;
 close STDIN ; $a = <STDIN> ;
 EXPECT
-Read on closed filehandle <STDIN> at - line 3.
+Read on closed filehandle main::STDIN at - line 3.
 ########
 # pp_hot.c
 use warning 'recursion' ;
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index 8f2c255bc3..82d1501147 100644
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -3,12 +3,12 @@
   untie attempted while %d inner references still exist
     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
 
-  Filehandle only opened for input
+  Filehandle %s opened only for input
     format STDIN =
     .
     write STDIN;
 
-  Write on closed filehandle
+  Write on closed filehandle %s
     format STDIN =
     .
     close STDIN;
@@ -91,7 +91,7 @@ format STDIN =
 .
 write STDIN;
 EXPECT
-Filehandle only opened for input at - line 5.
+Filehandle main::STDIN opened only for input at - line 5.
 ########
 # pp_sys.c
 use warning 'closed' ;
@@ -100,7 +100,7 @@ format STDIN =
 close STDIN;
 write STDIN;
 EXPECT
-Write on closed filehandle at - line 6.
+Write on closed filehandle main::STDIN at - line 6.
 ########
 # pp_sys.c
 use warning 'io' ;