Add test for #8145 (binmode() warning), add warning for

ioctl() and sockpair(), document them. (fileno() cannot
be tripwired with the same kind of warning because
'defined fileno($foo)' seems to be an idiom.)

p4raw-id: //depot/perl@8147

3 files changed, 71 insertions, 27 deletions

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 9baf175833..a27dde7e30 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -402,6 +402,11 @@ L<perlport> for more on portability concerns.
 (W closed) 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>.
 
+=item binmode() on closed filehandle %s
+
+(W unopened) You tried binmode() on a filehandle that was never opened.
+Check you control flow and number of arguments.
+
 =item Bit vector size > 32 non-portable
 
 (W portable) Using bit vector sizes larger than 32 is non-portable.
@@ -1387,7 +1392,7 @@ name.
 =item flock() on closed filehandle %s
 
 (W closed) The filehandle you're attempting to flock() got itself closed
-some time before now.  Check your logic flow.  flock() operates on
+some time before now.  Check your control flow.  flock() operates on
 filehandles.  Are you attempting to call flock() on a dirhandle by the
 same name?
 
@@ -1720,6 +1725,11 @@ silently ignored.
 (F) Your machine apparently doesn't implement ioctl(), which is pretty
 strange for a machine that supports C.
 
+=item ioctl() on unopened %s
+
+(W unopened) You tried ioctl() on a filehandle that was never opened.
+Check you control flow and number of arguments.
+
 =item `%s' is not a code reference
 
 (W) The second (fourth, sixth, ...) argument of overload::constant needs
@@ -2277,9 +2287,9 @@ the buffer and zero pad the new area.
 =item -%s on unopened filehandle %s
 
 (W unopened) You tried to invoke a file test operator on a filehandle
-that isn't open.  Check your logic.  See also L<perlfunc/-X>.
+that isn't open.  Check your control flow.  See also L<perlfunc/-X>.
 
-=item %s() on unopened %s %s
+=item %s() on unopened %s
 
 (W unopened) An I/O operation was attempted on a filehandle that was
 never initialized.  You need to do an open(), a sysopen(), or a socket()
@@ -2734,12 +2744,12 @@ See Server error.
 =item printf() on closed filehandle %s
 
 (W closed) The filehandle you're writing to got itself closed sometime
-before now.  Check your logic flow.
+before now.  Check your control flow.
 
 =item print() on closed filehandle %s
 
 (W closed) The filehandle you're printing on got itself closed sometime
-before now.  Check your logic flow.
+before now.  Check your control flow.
 
 =item Process terminated by SIG%s
 
@@ -2778,7 +2788,7 @@ by prepending "0" to your numbers.
 =item readline() on closed filehandle %s
 
 (W closed) The filehandle you're reading from got itself closed sometime
-before now.  Check your logic flow.
+before now.  Check your control flow.
 
 =item Reallocation too large: %lx
 
@@ -2943,7 +2953,7 @@ scalar that had previously been marked as free.
 =item send() on closed socket %s
 
 (W closed) The socket you're sending to got itself closed sometime
-before now.  Check your logic flow.
+before now.  Check your control flow.
 
 =item Sequence (? incomplete before << HERE mark in regex m/%s/
 
@@ -3218,7 +3228,7 @@ unconfigured.  Consult your system support.
 =item syswrite() on closed filehandle %s
 
 (W closed) The filehandle you're writing to got itself closed sometime
-before now.  Check your logic flow.
+before now.  Check your control flow.
 
 =item Target of goto is too deeply nested
 
@@ -3852,7 +3862,7 @@ So put in parentheses to say what you really mean.
 =item write() on closed filehandle %s
 
 (W closed) The filehandle you're writing to got itself closed sometime
-before now.  Check your logic flow.
+before now.  Check your control flow.
 
 =item X outside of string
 
diff --git a/pp_sys.c b/pp_sys.c
index 0c834ca60e..c1857ae7c3 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -645,8 +645,15 @@ PP(pp_fileno)
 	RETURN;
     }
 
-    if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
+    if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+	/* Can't do this because people seem to do things like
+	   defined(fileno($foo)) to check whether $foo is a valid fh.
+	  if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	      report_evil_fh(gv, io, PL_op->op_type);
+	    */
 	RETPUSHUNDEF;
+    }
+
     PUSHi(PerlIO_fileno(fp));
     RETURN;
 }
@@ -710,7 +717,8 @@ PP(pp_binmode)
 
     EXTEND(SP, 1);
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
-        report_evil_fh(gv, io, PL_op->op_type);
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	    report_evil_fh(gv, io, PL_op->op_type);
         RETPUSHUNDEF;
     }
 
@@ -2052,9 +2060,11 @@ PP(pp_ioctl)
     char *s;
     IV retval;
     GV *gv = (GV*)POPs;
-    IO *io = GvIOn(gv);
+    IO *io = gv ? GvIOn(gv) : 0;
 
     if (!io || !argsv || !IoIFP(io)) {
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	    report_evil_fh(gv, io, PL_op->op_type);
 	SETERRNO(EBADF,RMS$_IFI);	/* well, sort of... */
 	RETPUSHUNDEF;
     }
@@ -2166,16 +2176,17 @@ PP(pp_socket)
     int fd;
 
     gv = (GV*)POPs;
+    io = gv ? GvIOn(gv) : NULL;
 
-    if (!gv) {
+    if (!gv || !io) {
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	    report_evil_fh(gv, io, PL_op->op_type);
+	if (IoIFP(io))
+	    do_close(gv, FALSE);
 	SETERRNO(EBADF,LIB$_INVARG);
 	RETPUSHUNDEF;
     }
 
-    io = GvIOn(gv);
-    if (IoIFP(io))
-	do_close(gv, FALSE);
-
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0)
@@ -2214,15 +2225,21 @@ PP(pp_sockpair)
 
     gv2 = (GV*)POPs;
     gv1 = (GV*)POPs;
-    if (!gv1 || !gv2)
+    io1 = gv1 ? GvIOn(gv1) : NULL;
+    io2 = gv2 ? GvIOn(gv2) : NULL;
+    if (!gv1 || !gv2 || !io1 || !io2) {
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
+	    if (!gv1 || !io1)
+		report_evil_fh(gv1, io1, PL_op->op_type);
+	    if (!gv2 || !io2)
+		report_evil_fh(gv1, io2, PL_op->op_type);
+	}
+	if (IoIFP(io1))
+	    do_close(gv1, FALSE);
+	if (IoIFP(io2))
+	    do_close(gv2, FALSE);
 	RETPUSHUNDEF;
-
-    io1 = GvIOn(gv1);
-    io2 = GvIOn(gv2);
-    if (IoIFP(io1))
-	do_close(gv1, FALSE);
-    if (IoIFP(io2))
-	do_close(gv2, FALSE);
+    }
 
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
@@ -2348,9 +2365,9 @@ PP(pp_listen)
 #ifdef HAS_SOCKET
     int backlog = POPi;
     GV *gv = (GV*)POPs;
-    register IO *io = GvIOn(gv);
+    register IO *io = gv ? GvIOn(gv) : NULL;
 
-    if (!io || !IoIFP(io))
+    if (!gv || !io || !IoIFP(io))
 	goto nuts;
 
     if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index 66f3e750db..e30637b0d4 100644
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -3,6 +3,15 @@
   untie attempted while %d inner references still exist	[pp_untie]
     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
 
+  fileno() on unopened filehandle abc		[pp_fileno]
+    $a = "abc"; fileno($a)
+
+  binmode() on unopened filehandle abc		[pp_binmode]
+    $a = "abc"; fileno($a)
+
+  printf() on unopened filehandle abc		[pp_prtf]
+    $a = "abc"; printf $a "fred"
+
   Filehandle %s opened only for input		[pp_leavewrite]
     format STDIN =
     .
@@ -400,3 +409,11 @@ close F ;
 unlink $file ;
 EXPECT
 Filehandle F opened only for output at - line 12.
+########
+# pp_sys.c [pp_binmode]
+use warnings 'unopened' ;
+binmode(BLARG);
+$a = "BLERG";binmode($a);
+EXPECT
+binmode() on unopened filehandle BLARG at - line 3.
+binmode() on unopened filehandle at - line 4.