diff options
| -rw-r--r-- | doio.c | 53 | ||||
| -rw-r--r-- | pod/perldiag.pod | 12 | ||||
| -rw-r--r-- | pp_hot.c | 46 | ||||
| -rw-r--r-- | pp_sys.c | 111 | ||||
| -rw-r--r-- | t/pragma/warn/doio | 35 | ||||
| -rw-r--r-- | t/pragma/warn/pp_hot | 4 | ||||
| -rw-r--r-- | t/pragma/warn/pp_sys | 24 | ||||
| -rw-r--r-- | util.c | 12 |
8 files changed, 188 insertions, 109 deletions
@@ -810,9 +810,8 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) if (!io) { /* never opened */ if (not_implicit) { dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, - "close() on unopened filehandle %s",GvENAME(gv)); + if (ckWARN(WARN_UNOPENED)) /* no check for closed here */ + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,SS$_IVCHAN); } return FALSE; @@ -878,10 +877,19 @@ Perl_do_eof(pTHX_ GV *gv) && (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout() || IoIFP(io) == PerlIO_stderr())) { - SV* sv = sv_newmortal(); - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", - SvPV_nolen(sv)); + /* integrate to report_evil_fh()? */ + char *name = NULL; + if (isGV(gv)) { + SV* sv = sv_newmortal(); + gv_efullname4(sv, gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for output", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for output"); } while (IoIFP(io)) { @@ -925,8 +933,8 @@ Perl_do_tell(pTHX_ GV *gv) } { dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "tell() on unopened filehandle"); + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); } SETERRNO(EBADF,RMS$_IFI); return (Off_t)-1; @@ -947,8 +955,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) } { dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "seek() on unopened filehandle"); + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); } SETERRNO(EBADF,RMS$_IFI); return FALSE; @@ -964,8 +972,8 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); { dTHR; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "sysseek() on unopened filehandle"); + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); } SETERRNO(EBADF,RMS$_IFI); return (Off_t)-1; @@ -1179,25 +1187,24 @@ Perl_my_stat(pTHX) { djSP; IO *io; - GV* tmpgv; + GV* gv; if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); - tmpgv = cGVOP_gv; + gv = cGVOP_gv; do_fstat: - io = GvIO(tmpgv); + io = GvIO(gv); if (io && IoIFP(io)) { - PL_statgv = tmpgv; + PL_statgv = gv; sv_setpv(PL_statname,""); PL_laststype = OP_STAT; return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); } else { - if (tmpgv == PL_defgv) + if (gv == PL_defgv) return PL_laststatval; - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "%s on unopened filehandle %s", - PL_op_desc[PL_op->op_type], GvENAME(tmpgv)); + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); PL_statgv = Nullgv; sv_setpv(PL_statname,""); return (PL_laststatval = -1); @@ -1209,11 +1216,11 @@ Perl_my_stat(pTHX) STRLEN n_a; PUTBACK; if (SvTYPE(sv) == SVt_PVGV) { - tmpgv = (GV*)sv; + gv = (GV*)sv; goto do_fstat; } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { - tmpgv = (GV*)SvRV(sv); + gv = (GV*)SvRV(sv); goto do_fstat; } diff --git a/pod/perldiag.pod b/pod/perldiag.pod index cf6cd19b23..3699b6e80d 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1360,12 +1360,6 @@ you which section of the Perl source code is distressed. (F) Your machine apparently doesn't implement fcntl(). What is this, a PDP-11 or something? -=item Filehandle %s never opened - -(W unopened) An I/O operation was attempted on a filehandle that was -never initialized. You need to do an open() or a socket() call, or call -a constructor from the FileHandle package. - =item Filehandle %s opened only for input (W io) You tried to write on a read-only filehandle. If you intended it @@ -2258,6 +2252,12 @@ the buffer and zero pad the new area. (W unopened) You tried to invoke a file test operator on a filehandle that isn't open. Check your logic. See also L<perlfunc/-X>. +=item %s() on unopened %s %s + +(W unopened) An I/O operation was attempted on a filehandle that was +never initialized. You need to do an open(), a sysopen(), or a socket() +call, or call a constructor from the FileHandle package. + =item oops: oopsAV (S internal) An internal warning that the grammar is screwed up. @@ -398,25 +398,30 @@ PP(pp_print) RETURN; } if (!(io = GvIO(gv))) { - if (ckWARN(WARN_UNOPENED)) { - SV* sv = sv_newmortal(); - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened", - SvPV(sv,n_a)); - } + dTHR; + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); goto just_say_no; } else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED, WARN_IO)) { if (IoIFP(io)) { - SV* sv = sv_newmortal(); - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_IO, - "Filehandle %s opened only for input", - SvPV(sv,n_a)); + /* integrate with report_evil_fh()? */ + char *name = NULL; + if (isGV(gv)) { + SV* sv = sv_newmortal(); + gv_efullname4(sv, gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for input", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for input"); } - else if (ckWARN(WARN_CLOSED)) + else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); @@ -1381,10 +1386,19 @@ Perl_do_readline(pTHX) && (IoTYPE(io) == '>' || fp == PerlIO_stdout() || fp == PerlIO_stderr())) { - SV* sv = sv_newmortal(); - gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", - SvPV_nolen(sv)); + /* integrate with report_evil_fh()? */ + char *name = NULL; + if (isGV(PL_last_in_gv)) { /* can this ever fail? */ + SV* sv = sv_newmortal(); + gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for output", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for output"); } } if (!fp) { @@ -1174,11 +1174,14 @@ PP(pp_enterwrite) cv = GvFORM(fgv); if (!cv) { + char *name = NULL; if (fgv) { SV *tmpsv = sv_newmortal(); gv_efullname4(tmpsv, fgv, Nullch, FALSE); - DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv)); + name = SvPV_nolen(tmpsv); } + if (name && *name) + DIE(aTHX_ "Undefined format \"%s\" called", name); DIE(aTHX_ "Not a format reference"); } if (CvCLONE(cv)) @@ -1255,10 +1258,19 @@ PP(pp_leavewrite) if (!fgv) DIE(aTHX_ "bad top format reference"); cv = GvFORM(fgv); - if (!cv) { - SV *tmpsv = sv_newmortal(); - gv_efullname4(tmpsv, fgv, Nullch, FALSE); - DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv)); + { + char *name = NULL; + if (!cv) { + SV *sv = sv_newmortal(); + gv_efullname4(sv, fgv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + DIE(aTHX_ "Undefined top format \"%s\" called",name); + /* why no: + else + DIE(aTHX_ "Undefined top format called"); + ?*/ } if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); @@ -1274,11 +1286,19 @@ PP(pp_leavewrite) if (!fp) { if (ckWARN2(WARN_CLOSED,WARN_IO)) { if (IoIFP(io)) { - SV* sv = sv_newmortal(); - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_IO, - "Filehandle %s opened only for input", - SvPV_nolen(sv)); + /* integrate with report_evil_fh()? */ + char *name = NULL; + if (isGV(gv)) { + SV* sv = sv_newmortal(); + gv_efullname4(sv, gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for input", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for input"); } else if (ckWARN(WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); @@ -1344,21 +1364,27 @@ PP(pp_prtf) sv = NEWSV(0,0); if (!(io = GvIO(gv))) { - if (ckWARN(WARN_UNOPENED)) { - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_UNOPENED, - "Filehandle %s never opened", SvPV(sv,n_a)); - } + dTHR; + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); SETERRNO(EBADF,RMS$_IFI); goto just_say_no; } else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED,WARN_IO)) { + /* integrate with report_evil_fh()? */ if (IoIFP(io)) { - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_IO, - "Filehandle %s opened only for input", - SvPV(sv,n_a)); + char *name = NULL; + if (isGV(gv)) { + gv_efullname4(sv, gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for input", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for input"); } else if (ckWARN(WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); @@ -1550,10 +1576,19 @@ PP(pp_sysread) if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout() || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO)) { - SV* sv = sv_newmortal(); - gv_efullname4(sv, gv, Nullch, FALSE); - Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output", - SvPV_nolen(sv)); + /* integrate with report_evil_fh()? */ + char *name = NULL; + if (isGV(gv)) { + SV* sv = sv_newmortal(); + gv_efullname4(sv, gv, Nullch, FALSE); + name = SvPV_nolen(sv); + } + if (name && *name) + Perl_warner(aTHX_ WARN_IO, + "Filehandle %s opened only for output", name); + else + Perl_warner(aTHX_ WARN_IO, + "Filehandle opened only for output"); } goto say_undef; } @@ -2484,39 +2519,39 @@ PP(pp_lstat) PP(pp_stat) { djSP; - GV *tmpgv; + GV *gv; I32 gimme; I32 max = 13; STRLEN n_a; if (PL_op->op_flags & OPf_REF) { - tmpgv = cGVOP_gv; + gv = cGVOP_gv; if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO)) Perl_warner(aTHX_ WARN_IO, - "lstat() on filehandle %s", GvENAME(tmpgv)); + "lstat() on filehandle %s", GvENAME(gv)); do_fstat: - if (tmpgv != PL_defgv) { + if (gv != PL_defgv) { PL_laststype = OP_STAT; - PL_statgv = tmpgv; + PL_statgv = gv; sv_setpv(PL_statname, ""); - PL_laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv)) - ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &PL_statcache) : -1); + PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv)) + ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1); } if (PL_laststatval < 0) { - if (ckWARN(WARN_UNOPENED)) - Perl_warner(aTHX_ WARN_UNOPENED, "%s() on unopened filehandle %s", - PL_op_desc[PL_op->op_type], GvENAME(tmpgv)); + dTHR; + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, GvIO(gv), PL_op->op_type); max = 0; } } else { SV* sv = POPs; if (SvTYPE(sv) == SVt_PVGV) { - tmpgv = (GV*)sv; + gv = (GV*)sv; goto do_fstat; } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { - tmpgv = (GV*)SvRV(sv); + gv = (GV*)SvRV(sv); goto do_fstat; } sv_setpv(PL_statname, SvPV(sv,n_a)); @@ -3058,10 +3093,10 @@ PP(pp_fttext) len = 512; } else { - if (ckWARN(WARN_UNOPENED)) { + dTHR; + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) { gv = cGVOP_gv; - Perl_warner(aTHX_ WARN_UNOPENED, "%s on unopened filehandle %s", - PL_op_desc[PL_op->op_type], GvENAME(gv)); + report_evil_fh(gv, GvIO(gv), PL_op->op_type); } SETERRNO(EBADF,RMS$_IFI); RETPUSHUNDEF; diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index 00371031a4..2a357e2755 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -12,22 +12,22 @@ warn(warn_nl, "open"); [Perl_do_open9] open(F, "true\ncd") - close() on unopened filehandle %s [Perl_do_close] <<TODO + close() on unopened filehandle %s [Perl_do_close] $a = "fred";close("$a") - tell() on unopened filehandle [Perl_do_tell] + tell() on closed filehandle [Perl_do_tell] $a = "fred";$a = tell($a) - seek() on unopened filehandle [Perl_do_seek] + seek() on closed filehandle [Perl_do_seek] $a = "fred";$a = seek($a,1,1) - sysseek() on unopened filehandle [Perl_do_sysseek] + sysseek() on closed filehandle [Perl_do_sysseek] $a = "fred";$a = seek($a,1,1) warn(warn_uninit); [Perl_do_print] print $a ; - -x on unopened filehandle %s [Perl_my_stat] + -x on closed filehandle %s [Perl_my_stat] close STDIN ; -x STDIN ; warn(warn_nl, "stat"); [Perl_my_stat] @@ -106,6 +106,12 @@ $a = seek(STDIN,1,1); $a = sysseek(STDIN,1,1); -x STDIN ; stat(STDIN) ; +$a = "fred"; +tell($a); +seek($a,1,1); +sysseek($a,1,1); +-x $a; # ok +stat($a); # ok no warnings 'io' ; close STDIN ; tell(STDIN); @@ -113,12 +119,21 @@ $a = seek(STDIN,1,1); $a = sysseek(STDIN,1,1); -x STDIN ; stat(STDIN) ; +$a = "fred"; +tell($a); +seek($a,1,1); +sysseek($a,1,1); +-x $a; +stat($a); EXPECT -tell() on unopened filehandle at - line 4. -seek() on unopened filehandle at - line 5. -sysseek() on unopened filehandle at - line 6. --x on unopened filehandle STDIN at - line 7. -stat() on unopened filehandle STDIN at - line 8. +tell() on closed filehandle STDIN at - line 4. +seek() on closed filehandle STDIN at - line 5. +sysseek() on closed filehandle STDIN at - line 6. +-x on closed filehandle STDIN at - line 7. +stat() on closed filehandle STDIN at - line 8. +tell() on unopened filehandle at - line 10. +seek() on unopened filehandle at - line 11. +sysseek() on unopened filehandle at - line 12. ######## # doio.c [Perl_do_print] use warnings 'uninitialized' ; diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index fe874ef7ef..3c3cc6021f 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -1,6 +1,6 @@ pp_hot.c - Filehandle %s never opened [pp_print] + print() on unopened filehandle abc [pp_print] $f = $a = "abc" ; print $f $a Filehandle %s opened only for input [pp_print] @@ -52,7 +52,7 @@ print $f $a; no warnings 'unopened' ; print $f $a; EXPECT -Filehandle abc never opened at - line 4. +print() on unopened filehandle abc at - line 4. ######## # pp_hot.c [pp_print] use warnings 'io' ; diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index feef456c7a..413a17be26 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -16,7 +16,7 @@ page overflow [pp_leavewrite] - Filehandle %s never opened [pp_prtf] + printf() on unopened filehandle abc [pp_prtf] $a = "abc"; printf $a "fred" Filehandle %s opened only for input [pp_prtf] @@ -79,9 +79,9 @@ warn(warn_nl, "stat"); [pp_stat] - -T on unopened filehandle %s - stat() on unopened filehandle %s - close STDIN ; -T STDIN ; + -T on closed filehandle %s + stat() on closed filehandle %s + close STDIN ; -T STDIN ; stat(STDIN) ; warn(warn_nl, "open"); [pp_fttext] -T "abc\ndef" ; @@ -158,7 +158,7 @@ printf $a "fred"; no warnings 'unopened' ; printf $a "fred"; EXPECT -Filehandle abc never opened at - line 4. +printf() on unopened filehandle abc at - line 4. ######## # pp_sys.c [pp_prtf] use warnings 'closed' ; @@ -355,16 +355,22 @@ EXPECT lstat() on filehandle STDIN at - line 13. ######## # pp_sys.c [pp_fttext] -use warnings 'unopened' ; +use warnings qw(unopened closed) ; close STDIN ; -T STDIN ; stat(STDIN) ; -no warnings 'unopened' ; +-T HOCUS; +stat(POCUS); +no warnings qw(unopened closed) ; -T STDIN ; stat(STDIN); +-T HOCUS; +stat(POCUS); EXPECT --T on unopened filehandle STDIN at - line 4. -stat() on unopened filehandle STDIN at - line 5. +-T on closed filehandle STDIN at - line 4. +stat() on closed filehandle STDIN at - line 5. +-T on unopened filehandle HOCUS at - line 6. +stat() on unopened filehandle POCUS at - line 7. ######## # pp_sys.c [pp_fttext] use warnings 'newline' ; @@ -3897,12 +3897,12 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op) op == OP_LEAVEWRITE ? "write" : PL_op_desc[op]; char *pars = OP_IS_FILETEST(op) ? "" : "()"; - char *type = OP_IS_SOCKET(op) ? "socket" : "filehandle"; + char *type = OP_IS_SOCKET(op) || (io && IoTYPE(io) == 's') ? + "socket" : "filehandle"; char *name = NULL; if (isGV(gv)) { SV *sv = sv_newmortal(); - gv_efullname4(sv, gv, Nullch, FALSE); name = SvPVX(sv); } @@ -3910,19 +3910,21 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op) if (io && IoTYPE(io) == ' ') { vile = "closed"; warn = WARN_CLOSED; - } else { + } + else { vile = "unopened"; warn = WARN_UNOPENED; } - if (name) { + if (name && *name) { Perl_warner(aTHX_ warn, "%s%s on %s %s %s", func, pars, vile, type, name); if (io && IoDIRP(io)) Perl_warner(aTHX_ warn, "\t(Are you trying to call %s%s on dirhandle %s?)\n", func, pars, name); - } else { + } + else { Perl_warner(aTHX_ warn, "%s%s on %s %s", func, pars, vile, type); if (io && IoDIRP(io)) |