diff options
| -rw-r--r-- | doio.c | 9 | ||||
| -rw-r--r-- | perl.c | 16 | ||||
| -rw-r--r-- | pod/perldelta.pod | 21 | ||||
| -rw-r--r-- | pod/perldiag.pod | 12 | ||||
| -rw-r--r-- | pp_hot.c | 41 | ||||
| -rw-r--r-- | pp_sys.c | 36 | ||||
| -rw-r--r-- | t/pragma/warn/pp_hot | 18 | ||||
| -rw-r--r-- | t/pragma/warn/pp_sys | 8 |
8 files changed, 117 insertions, 44 deletions
@@ -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)) { @@ -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. @@ -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); @@ -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' ; |