[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
Re: [PATCH 5.5.63] warn on flock() on closed handle
This patch supercedes the previous patch (i.e., apply it to a virgin
5.5.63).
At Sarathy's suggestion, this patch adds Perl_ck_open_dir to util.c.
Perl_ck_open_dir takes an operator name, an IO*, and the IO*'s parent
GV*. If IoDIRP(io) is non-NULL, it emits a warning modifier (one
warning will have already fired) asking whether the user thinks he's
operating on a dirhandle.
Hm. The code is much simpler than its description. Like one of my
coworkers is fond of saying: "Nothing documents code like code." :-)
diff -rc perl5.005_63.dist/pod/perldiag.pod perl5.005_63/pod/perldiag.pod
*** perl5.005_63.dist/pod/perldiag.pod Wed Dec 8 00:23:13 1999
--- perl5.005_63/pod/perldiag.pod Fri Jan 14 14:30:09 2000
***************
*** 3557,3559 ****
--- 3557,3566 ----
=back
+ =item Flock on closed filehandle
+
+ (W) The filehandle you're attempting flock() got itself closed sometime
+ before now. Check your logic flow. flock() operates on filehandles.
+ Are you attempting to call flock() on a dirhandle by the same name?
+
+ =back
diff -rc perl5.005_63.dist/pp_hot.c perl5.005_63/pp_hot.c
*** perl5.005_63.dist/pp_hot.c Wed Dec 8 00:23:14 1999
--- perl5.005_63/pp_hot.c Fri Jan 14 12:17:53 2000
***************
*** 366,374 ****
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));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
--- 366,376 ----
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_ck_open_dir(aTHX_ gv, "print", io);
+ }
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
***************
*** 1257,1262 ****
--- 1259,1265 ----
Perl_warner(aTHX_ WARN_CLOSED,
"Read on closed filehandle %s",
SvPV_nolen(sv));
+ Perl_ck_open_dir(aTHX_ PL_last_in_gv, "readline (<>)", io);
}
}
if (gimme == G_SCALAR) {
diff -rc perl5.005_63.dist/pp_sys.c perl5.005_63/pp_sys.c
*** perl5.005_63.dist/pp_sys.c Wed Dec 8 00:23:14 1999
--- perl5.005_63/pp_sys.c Fri Jan 14 13:58:59 2000
***************
*** 1279,1287 ****
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));
}
PUSHs(&PL_sv_no);
}
--- 1279,1289 ----
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));
+ Perl_ck_open_dir(aTHX_ gv, "write", io);
+ }
}
PUSHs(&PL_sv_no);
}
***************
*** 1359,1367 ****
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));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
--- 1361,1371 ----
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_ck_open_dir(aTHX_ gv, "printf", io);
+ }
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
***************
*** 1630,1639 ****
if (!io || !IoIFP(io)) {
length = -1;
if (ckWARN(WARN_CLOSED)) {
! if (PL_op->op_type == OP_SYSWRITE)
Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle");
! else
Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket");
}
}
else if (PL_op->op_type == OP_SYSWRITE) {
--- 1634,1647 ----
if (!io || !IoIFP(io)) {
length = -1;
if (ckWARN(WARN_CLOSED)) {
! if (PL_op->op_type == OP_SYSWRITE) {
Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle");
! Perl_ck_open_dir(aTHX_ gv, "syswrite", io);
! }
! else {
Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket");
+ Perl_ck_open_dir(aTHX_ gv, "send", io);
+ }
}
}
else if (PL_op->op_type == OP_SYSWRITE) {
***************
*** 1986,1993 ****
(void)PerlIO_flush(fp);
value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
}
! else
value = 0;
PUSHi(value);
RETURN;
#else
--- 1994,2007 ----
(void)PerlIO_flush(fp);
value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
}
! else {
value = 0;
+ if (ckWARN(WARN_CLOSED)) {
+ Perl_warner(aTHX_ WARN_CLOSED, "Flock on closed filehandle");
+ Perl_ck_open_dir(aTHX_ gv, "flock", GvIO(gv));
+ }
+ }
+
PUSHi(value);
RETURN;
#else
***************
*** 2139,2146 ****
RETPUSHUNDEF;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
--- 2153,2162 ----
RETPUSHUNDEF;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd");
+ Perl_ck_open_dir(aTHX_ gv, "bind", io);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
***************
*** 2169,2176 ****
RETPUSHUNDEF;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
--- 2185,2194 ----
RETPUSHUNDEF;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd");
+ Perl_ck_open_dir(aTHX_ gv, "connect", io);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
***************
*** 2195,2202 ****
RETPUSHUNDEF;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
--- 2213,2222 ----
RETPUSHUNDEF;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd");
+ Perl_ck_open_dir(aTHX_ gv, "listen", io);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
***************
*** 2249,2256 ****
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
badexit:
--- 2269,2278 ----
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd");
+ Perl_ck_open_dir(aTHX_ ggv, "accept", ggv ? GvIO(ggv) : 0);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
badexit:
***************
*** 2276,2283 ****
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
--- 2298,2307 ----
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd");
+ Perl_ck_open_dir(aTHX_ gv, "shutdown", io);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
RETPUSHUNDEF;
#else
***************
*** 2355,2362 ****
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
--- 2379,2388 ----
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd");
+ Perl_ck_open_dir(aTHX_ gv, "[gs]etsockopt", io);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
***************
*** 2428,2435 ****
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED))
Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd");
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
--- 2454,2463 ----
RETURN;
nuts:
! if (ckWARN(WARN_CLOSED)) {
Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd");
+ Perl_ck_open_dir(aTHX_ gv, "get{sock, peer}name", io);
+ }
SETERRNO(EBADF,SS$_IVCHAN);
nuts2:
RETPUSHUNDEF;
diff -rc perl5.005_63.dist/t/pragma/warn/pp_hot perl5.005_63/t/pragma/warn/pp_hot
*** perl5.005_63.dist/t/pragma/warn/pp_hot Wed Dec 8 00:23:15 1999
--- perl5.005_63/t/pragma/warn/pp_hot Fri Jan 14 14:28:00 2000
***************
*** 83,92 ****
--- 83,99 ----
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,134 ****
########
# pp_hot.c [Perl_do_readline]
use warnings 'closed' ;
! close STDIN ; $a = <STDIN> ;
no warnings 'closed' ;
$a = <STDIN> ;
EXPECT
Read on closed filehandle main::STDIN at - line 3.
########
# pp_hot.c [Perl_do_readline]
use warnings 'io' ;
--- 131,144 ----
########
# pp_hot.c [Perl_do_readline]
use warnings 'closed' ;
! close STDIN ; $a = <STDIN> ;
! opendir STDIN, "." ; $a = <STDIN> ;
no warnings 'closed' ;
$a = <STDIN> ;
EXPECT
Read on closed filehandle main::STDIN at - line 3.
+ Read 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 -rc perl5.005_63.dist/t/pragma/warn/pp_sys perl5.005_63/t/pragma/warn/pp_sys
*** perl5.005_63.dist/t/pragma/warn/pp_sys Mon Sep 6 13:39:08 1999
--- perl5.005_63/t/pragma/warn/pp_sys Fri Jan 14 15:03:17 2000
***************
*** 50,56 ****
accept() on closed fd [pp_accept]
close STDIN;
! accept STDIN, "fred" ;
shutdown() on closed fd [pp_shutdown]
close STDIN;
--- 50,56 ----
accept() on closed fd [pp_accept]
close STDIN;
! accept "fred", STDIN ;
shutdown() on closed fd [pp_shutdown]
close STDIN;
***************
*** 66,71 ****
--- 66,75 ----
getsockname STDIN;
getpeername STDIN;
+ flock() on closed fd [pp_flock]
+ close STDIN;
+ flock STDIN, 8;
+
warn(warn_nl, "stat"); [pp_stat]
Test on unopened file <%s>
***************
*** 109,118 ****
--- 113,129 ----
.
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' ;
***************
*** 145,154 ****
--- 156,172 ----
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' ;
***************
*** 162,171 ****
--- 180,209 ----
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 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;
+ EXPECT
+ Flock on closed filehandle at - line 4.
+ Flock on closed filehandle 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' ;
***************
*** 192,209 ****
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
! accept STDIN, "fred" ;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
getsockname STDIN;
getpeername STDIN;
no warnings 'io' ;
send STDIN, "fred", 1;
bind STDIN, "fred" ;
connect STDIN, "fred" ;
listen STDIN, 2;
! accept STDIN, "fred" ;
shutdown STDIN, 0;
setsockopt STDIN, 1,2,3;
getsockopt STDIN, 1,2;
--- 230,270 ----
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;
! 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" ;
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;
! 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;
***************
*** 220,225 ****
--- 281,306 ----
[gs]etsockopt() on closed fd at - line 29.
get{sock, peer}name() on closed fd at - line 30.
get{sock, peer}name() on closed fd at - line 31.
+ Send on closed socket at - line 33.
+ (Are you trying to call send on dirhandle main::STDIN?)
+ bind() on closed fd at - line 34.
+ (Are you trying to call bind on dirhandle main::STDIN?)
+ connect() on closed fd at - line 35.
+ (Are you trying to call connect on dirhandle main::STDIN?)
+ listen() on closed fd at - line 36.
+ (Are you trying to call listen on dirhandle main::STDIN?)
+ accept() on closed fd at - line 37.
+ (Are you trying to call accept on dirhandle main::STDIN?)
+ shutdown() on closed fd at - line 38.
+ (Are you trying to call shutdown on dirhandle main::STDIN?)
+ [gs]etsockopt() on closed fd at - line 39.
+ (Are you trying to call [gs]etsockopt on dirhandle main::STDIN?)
+ [gs]etsockopt() on closed fd at - line 40.
+ (Are you trying to call [gs]etsockopt on dirhandle main::STDIN?)
+ get{sock, peer}name() on closed fd at - line 41.
+ (Are you trying to call get{sock, peer}name on dirhandle main::STDIN?)
+ get{sock, peer}name() on closed fd at - line 42.
+ (Are you trying to call get{sock, peer}name on dirhandle main::STDIN?)
########
# pp_sys.c [pp_stat]
use warnings 'newline' ;
diff -rc perl5.005_63.dist/util.c perl5.005_63/util.c
*** perl5.005_63.dist/util.c Tue Nov 30 21:47:11 1999
--- perl5.005_63/util.c Fri Jan 14 13:57:49 2000
***************
*** 3717,3719 ****
--- 3717,3737 ----
return Perl_atof(s);
#endif
}
+
+ void
+ Perl_ck_open_dir(pTHX_ GV *gv, char *func, IO *io)
+ {
+ if (!io)
+ return;
+
+ if (IoDIRP(io)) {
+ SV *sv = sv_newmortal();
+ STRLEN n_a;
+
+ gv_efullname3(sv, gv, Nullch);
+
+ Perl_warner(aTHX_ WARN_CLOSED,
+ "(Are you trying to call %s on dirhandle %s?)\n",
+ func, SvPV(sv, n_a));
+ }
+ }
End of Patch.
- Follow-Ups from:
-
Ronald J Kimball <rjk@linguist.dartmouth.edu>
Gurusamy Sarathy <gsar@ActiveState.com>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]