X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=1b5f278e730675a3a8db98bf8dcb8e0cde1dbdc1;hb=7ed149c909e2812f62b12bd7d09f4ccfb79e0041;hp=9bfe44ad8ab8d51725bf2690e32cbb9f875c6979;hpb=bc37a18f04c6e2feea5bb9e2e546e59c37c7c04a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 9bfe44a..1b5f278 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -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) {