#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
#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)
#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
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
Perl_vivify_defelem
Perl_vivify_ref
Perl_wait4pid
+Perl_report_closed_fh
Perl_report_uninit
Perl_warn
Perl_vwarn
#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
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)
(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>.
(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>.
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>.
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?
(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>.
(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.
(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.
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.
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?
=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
}
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;
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);
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);
}
}
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;
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) {
(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
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
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
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
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:
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
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;
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;
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);
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' ;
########
# 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' ;
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>
.
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' ;
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' ;
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' ;
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" ;
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' ;
}
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;
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);
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff