patch to report warnings on bogus filehandles passed to flock(),

more consistent warnings, from Greg Bacon <gbacon@itsc.uah.edu>
(slightly modified)

p4raw-id: //depot/perl@4830

diff --git a/embed.h b/embed.h
index 27685ff..2d5c36b 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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

diff --git a/embed.pl b/embed.pl
index 84d689e..95dfed9 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -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 0fc9739..734b663 100644 (file)
--- 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

diff --git a/objXSUB.h b/objXSUB.h
index 035367d..3b20d76 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -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

diff --git a/perlapi.c b/perlapi.c
index 589d8b6..437096b 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -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 752605d..2ce165b 100644 (file)
--- 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

diff --git a/pp_hot.c b/pp_hot.c
index 1e669c8..cd7b6e0 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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);

diff --git a/pp_sys.c b/pp_sys.c
index 39a599a..58271c8 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -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;

diff --git a/proto.h b/proto.h
index 36f4a40..76cb2f3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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 7e19dc5..312f7da 100644 (file)
--- 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 ea4b536..5808536 100644 (file)
--- 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' ;

diff --git a/util.c b/util.c
index 2ecb73a..09fa027 100644 (file)
--- a/util.c
+++ b/util.c
@@ -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);
+}