diff options
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | perlapi.c | 7 | ||||
| -rw-r--r-- | pod/perldiag.pod | 25 | ||||
| -rw-r--r-- | pp_hot.c | 19 | ||||
| -rw-r--r-- | pp_sys.c | 49 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | t/pragma/warn/pp_hot | 14 | ||||
| -rw-r--r-- | t/pragma/warn/pp_sys | 131 | ||||
| -rw-r--r-- | util.c | 23 |
12 files changed, 211 insertions, 68 deletions
@@ -712,6 +712,7 @@ #define vivify_defelem Perl_vivify_defelem #define vivify_ref Perl_vivify_ref #define wait4pid Perl_wait4pid +#define report_closed_fh Perl_report_closed_fh #define report_uninit Perl_report_uninit #define warn Perl_warn #define vwarn Perl_vwarn @@ -2129,6 +2130,7 @@ #define vivify_defelem(a) Perl_vivify_defelem(aTHX_ a) #define vivify_ref(a,b) Perl_vivify_ref(aTHX_ a,b) #define wait4pid(a,b,c) Perl_wait4pid(aTHX_ a,b,c) +#define report_closed_fh(a,b,c,d) Perl_report_closed_fh(aTHX_ a,b,c,d) #define report_uninit() Perl_report_uninit(aTHX) #define vwarn(a,b) Perl_vwarn(aTHX_ a,b) #define vwarner(a,b,c) Perl_vwarner(aTHX_ a,b,c) @@ -4172,6 +4174,8 @@ #define vivify_ref Perl_vivify_ref #define Perl_wait4pid CPerlObj::Perl_wait4pid #define wait4pid Perl_wait4pid +#define Perl_report_closed_fh CPerlObj::Perl_report_closed_fh +#define report_closed_fh Perl_report_closed_fh #define Perl_report_uninit CPerlObj::Perl_report_uninit #define report_uninit Perl_report_uninit #define Perl_warn CPerlObj::Perl_warn @@ -1766,6 +1766,7 @@ p |U8* |uv_to_utf8 |U8 *d|UV uv p |void |vivify_defelem |SV* sv p |void |vivify_ref |SV* sv|U32 to_what p |I32 |wait4pid |Pid_t pid|int* statusp|int flags +p |void |report_closed_fh|GV *gv|IO *io|const char *func|const char *obj p |void |report_uninit p |void |warn |const char* pat|... p |void |vwarn |const char* pat|va_list* args diff --git a/global.sym b/global.sym index 0fc9739a73..734b663884 100644 --- a/global.sym +++ b/global.sym @@ -620,6 +620,7 @@ Perl_uv_to_utf8 Perl_vivify_defelem Perl_vivify_ref Perl_wait4pid +Perl_report_closed_fh Perl_report_uninit Perl_warn Perl_vwarn @@ -3297,6 +3297,10 @@ #define Perl_wait4pid pPerl->Perl_wait4pid #undef wait4pid #define wait4pid Perl_wait4pid +#undef Perl_report_closed_fh +#define Perl_report_closed_fh pPerl->Perl_report_closed_fh +#undef report_closed_fh +#define report_closed_fh Perl_report_closed_fh #undef Perl_report_uninit #define Perl_report_uninit pPerl->Perl_report_uninit #undef report_uninit @@ -4449,6 +4449,13 @@ Perl_wait4pid(pTHXo_ Pid_t pid, int* statusp, int flags) return ((CPerlObj*)pPerl)->Perl_wait4pid(pid, statusp, flags); } +#undef Perl_report_closed_fh +void +Perl_report_closed_fh(pTHXo_ GV *gv, IO *io, const char *func, const char *obj) +{ + ((CPerlObj*)pPerl)->Perl_report_closed_fh(gv, io, func, obj); +} + #undef Perl_report_uninit void Perl_report_uninit(pTHXo) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 752605d2f8..2ce165b223 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -285,7 +285,7 @@ the string being unpacked. See L<perlfunc/pack>. (F) You wrote C<require E<lt>fileE<gt>> when you should have written C<require 'file'>. -=item accept() on closed socket +=item accept() on closed socket %s (W) You tried to do an accept on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/accept>. @@ -523,7 +523,7 @@ likely depends on its correct operation, Perl just gave up. (4294967295) and therefore non-portable between systems. See L<perlport> for more on portability concerns. -=item bind() on closed socket +=item bind() on closed socket %s (W) You tried to do a bind on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/bind>. @@ -1192,7 +1192,7 @@ than in the regular expression engine; or rewriting the regular expression so that it is simpler or backtracks less. (See L<perlbook> for information on I<Mastering Regular Expressions>.) -=item connect() on closed socket +=item connect() on closed socket %s (W) You tried to do a connect on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/connect>. @@ -1494,7 +1494,7 @@ when you meant because if it did, it'd feel morally obligated to return every hostname on the Internet. -=item get%sname() on closed socket +=item get%sname() on closed socket %s (W) You tried to get a socket or peer socket name on a closed socket. Did you forget to check the return value of your socket() call? @@ -1771,7 +1771,7 @@ L<perlfunc/last>. (F) While under the C<use filetest> pragma, switching the real and effective uids or gids failed. -=item listen() on closed socket +=item listen() on closed socket %s (W) You tried to do a listen on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/listen>. @@ -2659,7 +2659,7 @@ that had previously been marked as free. (W) A nearby syntax error was probably caused by a missing semicolon, or possibly some other missing operator, such as a comma. -=item send() on closed socket +=item send() on closed socket %s (W) The socket you're sending to got itself closed sometime before now. Check your logic flow. @@ -2748,7 +2748,7 @@ because the world might have written on it already. (F) You don't have System V shared memory IPC on your system. -=item shutdown() on closed socket +=item shutdown() on closed socket %s (W) You tried to do a shutdown on a closed socket. Seems a bit superfluous. @@ -2886,7 +2886,7 @@ into Perl yourself. machine. In some machines the functionality can exist but be unconfigured. Consult your system support. -=item syswrite() on closed filehandle +=item syswrite() on closed filehandle %s (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -3497,7 +3497,7 @@ already have a subroutine of that name declared, which means that Perl 5 will try to call the subroutine when the assignment is executed, which is probably not what you want. (If it IS what you want, put an & in front.) -=item %cetsockopt() on closed fd +=item %cetsockopt() on closed socket %s (W) You tried to get or set a socket option on a closed socket. Did you forget to check the return value of your socket() call? @@ -3567,3 +3567,10 @@ in F<README.os2>. =back +=item flock() on closed filehandle %s + +(W) The filehandle you're attempting to flock() got itself closed some +time before now. Check your logic flow. flock() operates on filehandles. +Are you attempting to call flock() on a dirhandle by the same name? + +=back @@ -365,15 +365,15 @@ PP(pp_print) } else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED, WARN_IO)) { - SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); - if (IoIFP(io)) + if (IoIFP(io)) { + SV* sv = sv_newmortal(); + gv_efullname3(sv, gv, Nullch); 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)); + report_closed_fh(gv, io, "print", "filehandle"); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1256,13 +1256,8 @@ Perl_do_readline(pTHX) 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, - "readline() on closed filehandle %s", - SvPV_nolen(sv)); - } + else + report_closed_fh(PL_last_in_gv, io, "readline", "filehandle"); } if (gimme == G_SCALAR) { (void)SvOK_off(TARG); @@ -1271,15 +1271,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)) + if (IoIFP(io)) { + SV* sv = sv_newmortal(); + gv_efullname3(sv, gv, Nullch); 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 %s", SvPV_nolen(sv)); + report_closed_fh(gv, io, "write", "filehandle"); } PUSHs(&PL_sv_no); } @@ -1352,14 +1352,14 @@ PP(pp_prtf) } else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED,WARN_IO)) { - gv_efullname3(sv, gv, Nullch); - if (IoIFP(io)) + if (IoIFP(io)) { + gv_efullname3(sv, gv, Nullch); 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)); + report_closed_fh(gv, io, "printf", "filehandle"); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1629,9 +1629,9 @@ PP(pp_send) length = -1; if (ckWARN(WARN_CLOSED)) { if (PL_op->op_type == OP_SYSWRITE) - Perl_warner(aTHX_ WARN_CLOSED, "syswrite() on closed filehandle"); + report_closed_fh(gv, io, "syswrite", "filehandle"); else - Perl_warner(aTHX_ WARN_CLOSED, "send() on closed socket"); + report_closed_fh(gv, io, "send", "socket"); } } else if (PL_op->op_type == OP_SYSWRITE) { @@ -1984,8 +1984,12 @@ PP(pp_flock) (void)PerlIO_flush(fp); value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); } - else + else { value = 0; + SETERRNO(EBADF,RMS$_IFI); + if (ckWARN(WARN_CLOSED)) + report_closed_fh(gv, GvIO(gv), "flock", "filehandle"); + } PUSHi(value); RETURN; #else @@ -2138,7 +2142,7 @@ PP(pp_bind) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed socket"); + report_closed_fh(gv, io, "bind", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2168,7 +2172,7 @@ PP(pp_connect) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed socket"); + report_closed_fh(gv, io, "connect", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2194,7 +2198,7 @@ PP(pp_listen) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed socket"); + report_closed_fh(gv, io, "listen", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2248,7 +2252,7 @@ PP(pp_accept) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed socket"); + report_closed_fh(ggv, ggv ? GvIO(ggv) : 0, "accept", "socket"); SETERRNO(EBADF,SS$_IVCHAN); badexit: @@ -2275,7 +2279,7 @@ PP(pp_shutdown) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed socket"); + report_closed_fh(gv, io, "shutdown", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2354,8 +2358,9 @@ PP(pp_ssockopt) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "%cetsockopt() on closed socket", - optype == OP_GSOCKOPT ? 'g' : 's'); + report_closed_fh(gv, io, + optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt", + "socket"); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -2428,8 +2433,10 @@ PP(pp_getpeername) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "get%sname() on closed socket", - optype == OP_GETSOCKNAME ? "sock" : "peer"); + report_closed_fh(gv, io, + optype == OP_GETSOCKNAME ? "getsockname" + : "getpeername", + "socket"); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -710,6 +710,7 @@ PERL_CALLCONV U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv); PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv); PERL_CALLCONV void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what); PERL_CALLCONV I32 Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags); +PERL_CALLCONV void Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj); PERL_CALLCONV void Perl_report_uninit(pTHX); PERL_CALLCONV void Perl_warn(pTHX_ const char* pat, ...); PERL_CALLCONV void Perl_vwarn(pTHX_ const char* pat, va_list* args); diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 7e19dc5c94..312f7da9b2 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -83,10 +83,17 @@ Filehandle main::FOO opened only for output at - line 8. use warnings 'closed' ; close STDIN ; print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; +closedir STDIN; no warnings 'closed' ; print STDIN "anc"; +opendir STDIN, "."; +print STDIN "anc"; EXPECT print() on closed filehandle main::STDIN at - line 4. +print() on closed filehandle main::STDIN at - line 6. +(Are you trying to call print() on dirhandle main::STDIN?) ######## # pp_hot.c [pp_rv2av] use warnings 'uninitialized' ; @@ -124,11 +131,16 @@ Reference found where even-sized list expected at - line 3. ######## # pp_hot.c [Perl_do_readline] use warnings 'closed' ; -close STDIN ; $a = <STDIN> ; +close STDIN ; $a = <STDIN> ; +opendir STDIN, "." ; $a = <STDIN> ; +closedir STDIN; no warnings 'closed' ; +opendir STDIN, "." ; $a = <STDIN> ; $a = <STDIN> ; EXPECT readline() on closed filehandle main::STDIN at - line 3. +readline() on closed filehandle main::STDIN at - line 4. +(Are you trying to call readline() on dirhandle main::STDIN?) ######## # pp_hot.c [Perl_do_readline] use warnings 'io' ; diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index ea4b536842..5808536752 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -27,47 +27,51 @@ close STDIN ; printf STDIN "fred" - syswrite() on closed filehandle [pp_send] + syswrite() on closed filehandle %s [pp_send] close STDIN; syswrite STDIN, "fred", 1; - send() on closed socket [pp_send] + send() on closed socket %s [pp_send] close STDIN; send STDIN, "fred", 1 - bind() on closed socket [pp_bind] + bind() on closed socket %s [pp_bind] close STDIN; bind STDIN, "fred" ; - connect() on closed socket [pp_connect] + connect() on closed socket %s [pp_connect] close STDIN; connect STDIN, "fred" ; - listen() on closed socket [pp_listen] + listen() on closed socket %s [pp_listen] close STDIN; listen STDIN, 2; - accept() on closed socket [pp_accept] + accept() on closed socket %s [pp_accept] close STDIN; - accept STDIN, "fred" ; + accept "fred", STDIN ; - shutdown() on closed socket [pp_shutdown] + shutdown() on closed socket %s [pp_shutdown] close STDIN; shutdown STDIN, 0; - setsockopt() on closed socket [pp_ssockopt] - getsockopt() on closed socket [pp_ssockopt] + setsockopt() on closed socket %s [pp_ssockopt] + getsockopt() on closed socket %s [pp_ssockopt] close STDIN; setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; - getsockname() on closed socket [pp_getpeername] - getpeername() on closed socket [pp_getpeername] + getsockname() on closed socket %s [pp_getpeername] + getpeername() on closed socket %s [pp_getpeername] close STDIN; getsockname STDIN; getpeername STDIN; + flock() on closed socket %s [pp_flock] + close STDIN; + flock STDIN, 8; + warn(warn_nl, "stat"); [pp_stat] Test on unopened file <%s> @@ -111,10 +115,17 @@ format STDIN = . close STDIN; write STDIN; +opendir STDIN, "."; +write STDIN; +closedir STDIN; no warnings 'closed' ; write STDIN; +opendir STDIN, "."; +write STDIN; EXPECT write() on closed filehandle main::STDIN at - line 6. +write() on closed filehandle main::STDIN at - line 8. +(Are you trying to call write() on dirhandle main::STDIN?) ######## # pp_sys.c [pp_leavewrite] use warnings 'io' ; @@ -147,10 +158,17 @@ Filehandle main::abc never opened at - line 4. use warnings 'closed' ; close STDIN ; printf STDIN "fred"; +opendir STDIN, "."; +printf STDIN "fred"; +closedir STDIN; no warnings 'closed' ; printf STDIN "fred"; +opendir STDIN, "."; +printf STDIN "fred"; EXPECT printf() on closed filehandle main::STDIN at - line 4. +printf() on closed filehandle main::STDIN at - line 6. +(Are you trying to call printf() on dirhandle main::STDIN?) ######## # pp_sys.c [pp_prtf] use warnings 'io' ; @@ -164,10 +182,32 @@ Filehandle main::STDIN opened only for input at - line 3. use warnings 'closed' ; close STDIN; syswrite STDIN, "fred", 1; +opendir STDIN, "."; +syswrite STDIN, "fred", 1; +closedir STDIN; no warnings 'closed' ; syswrite STDIN, "fred", 1; +opendir STDIN, "."; +syswrite STDIN, "fred", 1; EXPECT -syswrite() on closed filehandle at - line 4. +syswrite() on closed filehandle main::STDIN at - line 4. +syswrite() on closed filehandle main::STDIN at - line 6. +(Are you trying to call syswrite() on dirhandle main::STDIN?) +######## +# pp_sys.c [pp_flock] +use warnings 'closed' ; +close STDIN; +flock STDIN, 8; +opendir STDIN, "."; +flock STDIN, 8; +no warnings 'closed' ; +flock STDIN, 8; +opendir STDIN, "."; +flock STDIN, 8; +EXPECT +flock() on closed filehandle main::STDIN at - line 4. +flock() on closed filehandle main::STDIN at - line 6. +(Are you trying to call flock() on dirhandle main::STDIN?) ######## # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername] use warnings 'io' ; @@ -194,12 +234,24 @@ send STDIN, "fred", 1; bind STDIN, "fred" ; connect STDIN, "fred" ; listen STDIN, 2; -accept STDIN, "fred" ; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; +opendir STDIN, "."; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; shutdown STDIN, 0; setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; +closedir STDIN; no warnings 'io' ; send STDIN, "fred", 1; bind STDIN, "fred" ; @@ -211,17 +263,48 @@ setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; +opendir STDIN, "."; +send STDIN, "fred", 1; +bind STDIN, "fred" ; +connect STDIN, "fred" ; +listen STDIN, 2; +accept "fred", STDIN; +shutdown STDIN, 0; +setsockopt STDIN, 1,2,3; +getsockopt STDIN, 1,2; +getsockname STDIN; +getpeername STDIN; EXPECT -send() on closed socket at - line 22. -bind() on closed socket at - line 23. -connect() on closed socket at - line 24. -listen() on closed socket at - line 25. -accept() on closed socket at - line 26. -shutdown() on closed socket at - line 27. -setsockopt() on closed socket at - line 28. -getsockopt() on closed socket at - line 29. -getsockname() on closed socket at - line 30. -getpeername() on closed socket at - line 31. +send() on closed socket main::STDIN at - line 22. +bind() on closed socket main::STDIN at - line 23. +connect() on closed socket main::STDIN at - line 24. +listen() on closed socket main::STDIN at - line 25. +accept() on closed socket main::STDIN at - line 26. +shutdown() on closed socket main::STDIN at - line 27. +setsockopt() on closed socket main::STDIN at - line 28. +getsockopt() on closed socket main::STDIN at - line 29. +getsockname() on closed socket main::STDIN at - line 30. +getpeername() on closed socket main::STDIN at - line 31. +send() on closed socket main::STDIN at - line 33. +(Are you trying to call send() on dirhandle main::STDIN?) +bind() on closed socket main::STDIN at - line 34. +(Are you trying to call bind() on dirhandle main::STDIN?) +connect() on closed socket main::STDIN at - line 35. +(Are you trying to call connect() on dirhandle main::STDIN?) +listen() on closed socket main::STDIN at - line 36. +(Are you trying to call listen() on dirhandle main::STDIN?) +accept() on closed socket main::STDIN at - line 37. +(Are you trying to call accept() on dirhandle main::STDIN?) +shutdown() on closed socket main::STDIN at - line 38. +(Are you trying to call shutdown() on dirhandle main::STDIN?) +setsockopt() on closed socket main::STDIN at - line 39. +(Are you trying to call setsockopt() on dirhandle main::STDIN?) +getsockopt() on closed socket main::STDIN at - line 40. +(Are you trying to call getsockopt() on dirhandle main::STDIN?) +getsockname() on closed socket main::STDIN at - line 41. +(Are you trying to call getsockname() on dirhandle main::STDIN?) +getpeername() on closed socket main::STDIN at - line 42. +(Are you trying to call getpeername() on dirhandle main::STDIN?) ######## # pp_sys.c [pp_stat] use warnings 'newline' ; @@ -3702,7 +3702,8 @@ Perl_my_fflush_all(pTHX) } NV -Perl_my_atof(pTHX_ const char* s) { +Perl_my_atof(pTHX_ const char* s) +{ #ifdef USE_LOCALE_NUMERIC if ((PL_hints & HINT_LOCALE) && PL_numeric_local) { NV x, y; @@ -3721,3 +3722,23 @@ Perl_my_atof(pTHX_ const char* s) { return Perl_atof(s); #endif } + +void +Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj) +{ + SV *sv; + char *name; + + assert(gv); + + sv = sv_newmortal(); + gv_efullname3(sv, gv, Nullch); + name = SvPVX(sv); + + Perl_warner(aTHX_ WARN_CLOSED, "%s() on closed %s %s", func, obj, name); + + if (io && IoDIRP(io)) + Perl_warner(aTHX_ WARN_CLOSED, + "(Are you trying to call %s() on dirhandle %s?)\n", + func, name); +} |