partly fix perldiag regressions identified by Tom Christiansen
Gurusamy Sarathy [Tue, 28 Dec 1999 01:20:39 +0000 (01:20 +0000)]
p4raw-id: //depot/perl@4709

doio.c
lib/diagnostics.pm
pod/perldiag.pod
pp_hot.c
pp_sys.c
t/pragma/warn/4lint
t/pragma/warn/doio
t/pragma/warn/pp_hot
t/pragma/warn/pp_sys

diff --git a/doio.c b/doio.c
index 37e061a..c13228a 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -236,7 +236,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                dTHR;
                name[strlen(name)-1] = '\0' ;
                if (ckWARN(WARN_PIPE))
-                   Perl_warner(aTHX_ WARN_PIPE, "Can't do bidirectional pipe");
+                   Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe");
            }
            fp = PerlProc_popen(name,"w");
            writing = 1;
@@ -660,9 +660,9 @@ Perl_nextargv(pTHX_ register GV *gv)
                if (!S_ISREG(PL_statbuf.st_mode))       
                    Perl_warner(aTHX_ WARN_INPLACE,
                                "Can't do inplace edit: %s is not a regular file",
-                               PL_oldname );
+                               PL_oldname);
                else
-                   Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s\n",
+                   Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s",
                                PL_oldname, Strerror(errno));
            }
        }
index d405e36..aff9b55 100755 (executable)
@@ -333,7 +333,7 @@ EOFUNC
        # strip formatting directives in =item line
        ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
 
-       if ($header =~ /%[sd]/) {
+       if ($header =~ /%[csd]/) {
            $rhs = $lhs = $header;
            #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
            if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
@@ -346,6 +346,7 @@ EOFUNC
                $lhs =~ s/\377//g;
                $lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
            } 
+           $lhs =~ s/\\%c/./g;
            $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}s\n\t&& return 1;\n";
        } else {
            $transmo .= "    m{^\Q$header\E} && return 1;\n";
index f47ae5a..20ab4d9 100644 (file)
@@ -280,7 +280,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 fd
+=item accept() on closed socket
 
 (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>.
@@ -518,7 +518,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 fd
+=item bind() on closed socket
 
 (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>.
@@ -1068,7 +1068,7 @@ most likely an unexpected right brace '}'.
 reference of the type needed.  You can use the ref() function to
 test the type of the reference, if need be.
 
-=item Can't use \1 to mean $1 in expression
+=item Can't use \%c to mean $%c in expression
 
 (W) In an ordinary expression, backslash is a unary operator that creates
 a reference to its argument.  The use of backslash to indicate a backreference
@@ -1076,7 +1076,7 @@ to a matched substring is valid only as part of a regular expression pattern.
 Trying to do this in ordinary Perl code produces a value that prints
 out looking like SCALAR(0xdecaf).  Use the $1 form instead.
 
-=item Can't use bareword ("%s") as %s ref while \"strict refs\" in use
+=item Can't use bareword ("%s") as %s ref while "strict refs" in use
 
 (F) Only hard references are allowed by "strict refs".  Symbolic references
 are disallowed.  See L<perlref>.
@@ -1187,7 +1187,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 fd
+=item connect() on closed socket
 
 (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>.
@@ -1489,7 +1489,7 @@ when you meant
 because if it did, it'd feel morally obligated to return every hostname
 on the Internet.
 
-=item get{sock,peer}name() on closed fd
+=item get%sname() on closed socket
 
 (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?
@@ -1766,7 +1766,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 fd
+=item listen() on closed socket
 
 (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>.
@@ -2483,12 +2483,12 @@ instead of "||".
 
 See Server error.
 
-=item print on closed filehandle %s
+=item print() on closed filehandle %s
 
 (W) The filehandle you're printing on got itself closed sometime before now.
 Check your logic flow.
 
-=item printf on closed filehandle %s
+=item printf() on closed filehandle %s
 
 (W) The filehandle you're writing to got itself closed sometime before now.
 Check your logic flow.
@@ -2513,7 +2513,7 @@ are outside the range which can be represented by integers internally.
 One possible workaround is to force Perl to use magical string
 increment by prepending "0" to your numbers.
 
-=item Read on closed filehandle %s
+=item readline() on closed filehandle %s
 
 (W) The filehandle you're reading from got itself closed sometime before now.
 Check your logic flow.
@@ -2654,9 +2654,9 @@ 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
 
-(W) The filehandle you're sending to got itself closed sometime before now.
+(W) The socket you're sending to got itself closed sometime before now.
 Check your logic flow.
 
 =item Sequence (? incomplete
@@ -2743,7 +2743,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 fd
+=item shutdown() on closed socket
 
 (W) You tried to do a shutdown on a closed socket.  Seems a bit superfluous.
 
@@ -2881,7 +2881,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
 
 (W) The filehandle you're writing to got itself closed sometime before now.
 Check your logic flow.
@@ -3449,7 +3449,7 @@ but in actual fact, you got
 
 So put in parentheses to say what you really mean.
 
-=item Write on closed filehandle %s
+=item write() on closed filehandle %s
 
 (W) The filehandle you're writing to got itself closed sometime before now.
 Check your logic flow.
@@ -3492,11 +3492,11 @@ 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 [gs]etsockopt() on closed fd
+=item %cetsockopt() on closed fd
 
 (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?
-See L<perlfunc/getsockopt>.
+See L<perlfunc/getsockopt> and L<perlfunc/setsockopt>.
 
 =item \1 better written as $1
 
index 743913d..e83f0b8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -368,7 +368,7 @@ PP(pp_print)
                            SvPV(sv,n_a));
            else if (ckWARN(WARN_CLOSED))
                Perl_warner(aTHX_ WARN_CLOSED,
-                           "print on closed filehandle %s", SvPV(sv,n_a));
+                           "print() on closed filehandle %s", SvPV(sv,n_a));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -1255,7 +1255,7 @@ Perl_do_readline(pTHX)
                SV* sv = sv_newmortal();
                gv_efullname3(sv, PL_last_in_gv, Nullch);
                Perl_warner(aTHX_ WARN_CLOSED,
-                           "Read on closed filehandle %s",
+                           "readline() on closed filehandle %s",
                            SvPV_nolen(sv));
            }
        }
index 96ba78b..b0227a5 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1281,7 +1281,7 @@ PP(pp_leavewrite)
                            SvPV_nolen(sv));
            else if (ckWARN(WARN_CLOSED))
                Perl_warner(aTHX_ WARN_CLOSED,
-                           "Write on closed filehandle %s", SvPV_nolen(sv));
+                           "write() on closed filehandle %s", SvPV_nolen(sv));
        }
        PUSHs(&PL_sv_no);
     }
@@ -1361,7 +1361,7 @@ PP(pp_prtf)
                            SvPV(sv,n_a));
            else if (ckWARN(WARN_CLOSED))
                Perl_warner(aTHX_ WARN_CLOSED,
-                           "printf on closed filehandle %s", SvPV(sv,n_a));
+                           "printf() on closed filehandle %s", SvPV(sv,n_a));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -1631,9 +1631,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");
+               Perl_warner(aTHX_ WARN_CLOSED, "syswrite() on closed filehandle");
            else
-               Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket");
+               Perl_warner(aTHX_ WARN_CLOSED, "send() on closed socket");
        }
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
@@ -2140,7 +2140,7 @@ PP(pp_bind)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2170,7 +2170,7 @@ PP(pp_connect)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2196,7 +2196,7 @@ PP(pp_listen)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2250,7 +2250,7 @@ PP(pp_accept)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
@@ -2277,7 +2277,7 @@ PP(pp_shutdown)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2356,7 +2356,8 @@ PP(pp_ssockopt)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "%cetsockopt() on closed socket",
+                   optype == OP_GSOCKOPT ? 'g' : 's');
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2429,7 +2430,8 @@ PP(pp_getpeername)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd");
+       Perl_warner(aTHX_ WARN_CLOSED, "get%sname() on closed socket",
+                   optype == OP_GETSOCKNAME ? "sock" : "peer");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
index b7c64c3..db54f31 100644 (file)
@@ -9,14 +9,14 @@ $a = 1 if $a EQ $b ;
 close STDIN ; print STDIN "abc" ;
 EXPECT
 Use of EQ is deprecated at - line 5.
-print on closed filehandle main::STDIN at - line 6.
+print() on closed filehandle main::STDIN at - line 6.
 ########
 -W
 # lint: check runtime $^W is zapped
 $^W = 0 ;
 close STDIN ; print STDIN "abc" ;
 EXPECT
-print on closed filehandle main::STDIN at - line 4.
+print() on closed filehandle main::STDIN at - line 4.
 ########
 -W
 # lint: check runtime $^W is zapped
@@ -25,7 +25,7 @@ print on closed filehandle main::STDIN at - line 4.
   close STDIN ; print STDIN "abc" ;
 }
 EXPECT
-print on closed filehandle main::STDIN at - line 5.
+print() on closed filehandle main::STDIN at - line 5.
 ########
 -W
 # lint: check "no warnings" is zapped
@@ -35,7 +35,7 @@ $a = 1 if $a EQ $b ;
 close STDIN ; print STDIN "abc" ;
 EXPECT
 Use of EQ is deprecated at - line 5.
-print on closed filehandle main::STDIN at - line 6.
+print() on closed filehandle main::STDIN at - line 6.
 ########
 -W
 # lint: check "no warnings" is zapped
@@ -44,7 +44,7 @@ print on closed filehandle main::STDIN at - line 6.
   close STDIN ; print STDIN "abc" ;
 }
 EXPECT
-print on closed filehandle main::STDIN at - line 5.
+print() on closed filehandle main::STDIN at - line 5.
 ########
 -Ww
 # lint: check combination of -w and -W
@@ -53,7 +53,7 @@ print on closed filehandle main::STDIN at - line 5.
   close STDIN ; print STDIN "abc" ;
 }
 EXPECT
-print on closed filehandle main::STDIN at - line 5.
+print() on closed filehandle main::STDIN at - line 5.
 ########
 -W
 --FILE-- abc.pm
index 4706aeb..57dd993 100644 (file)
@@ -1,6 +1,6 @@
   doio.c       
 
-  Can't do bidirectional pipe          [Perl_do_open9]
+  Can't open bidirectional pipe                [Perl_do_open9]
     open(F, "| true |");
 
   Missing command in piped open                [Perl_do_open9]
@@ -64,7 +64,7 @@ no warnings 'io' ;
 open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
 close(G);
 EXPECT
-Can't do bidirectional pipe at - line 3.
+Can't open bidirectional pipe at - line 3.
 ########
 # doio.c [Perl_do_open9]
 use warnings 'io' ;
index 379918b..7e19dc5 100644 (file)
@@ -9,7 +9,7 @@
   Filehandle %s opened only for output         [pp_print]
     print <STDOUT> ;
 
-  print on closed filehandle %s                        [pp_print]
+  print() on closed filehandle %s              [pp_print]
     close STDIN ; print STDIN "abc" ;
 
   uninitialized                                        [pp_rv2av]
@@ -30,7 +30,7 @@
 
   glob failed (can't start child: %s)          [Perl_do_readline] <<TODO
 
-  Read on closed filehandle %s                 [Perl_do_readline]
+  readline() on closed filehandle %s           [Perl_do_readline]
     close STDIN ; $a = <STDIN>;
 
   glob failed (child exited with status %d%s)  [Perl_do_readline] <<TODO
@@ -86,7 +86,7 @@ print STDIN "anc";
 no warnings 'closed' ;
 print STDIN "anc";
 EXPECT
-print on closed filehandle main::STDIN at - line 4.
+print() on closed filehandle main::STDIN at - line 4.
 ########
 # pp_hot.c [pp_rv2av]
 use warnings 'uninitialized' ;
@@ -128,7 +128,7 @@ close STDIN ; $a = <STDIN> ;
 no warnings 'closed' ;
 $a = <STDIN> ;
 EXPECT
-Read on closed filehandle main::STDIN at - line 3.
+readline() on closed filehandle main::STDIN at - line 3.
 ########
 # pp_hot.c [Perl_do_readline]
 use warnings 'io' ;
index 651cdf9..ea4b536 100644 (file)
@@ -8,7 +8,7 @@
     .
     write STDIN;
 
-  Write on closed filehandle %s                        [pp_leavewrite]
+  write() on closed filehandle %s              [pp_leavewrite]
     format STDIN =
     .
     close STDIN;
     $a = "abc"; 
     printf $a "fred"
 
-  printf on closed filehandle %s               [pp_prtf]
+  printf() on closed filehandle %s             [pp_prtf]
     close STDIN ;
     printf STDIN "fred"
 
-  Syswrite on closed filehandle                        [pp_send]
+  syswrite() on closed filehandle              [pp_send]
     close STDIN; 
     syswrite STDIN, "fred", 1;
 
-  Send on closed socket                                [pp_send]
+  send() on closed socket                      [pp_send]
     close STDIN; 
     send STDIN, "fred", 1
 
-  bind() on closed fd                          [pp_bind]
+  bind() on closed socket                      [pp_bind]
     close STDIN; 
     bind STDIN, "fred" ;
 
 
-  connect() on closed fd                       [pp_connect]
+  connect() on closed socket                   [pp_connect]
     close STDIN; 
     connect STDIN, "fred" ;
 
-  listen() on closed fd                                [pp_listen]
+  listen() on closed socket                    [pp_listen]
     close STDIN; 
     listen STDIN, 2;
 
-  accept() on closed fd                                [pp_accept]
+  accept() on closed socket                    [pp_accept]
     close STDIN; 
     accept STDIN, "fred" ;
 
-  shutdown() on closed fd                      [pp_shutdown]
+  shutdown() on closed socket                  [pp_shutdown]
     close STDIN; 
     shutdown STDIN, 0;
 
-  [gs]etsockopt() on closed fd                 [pp_ssockopt]
+  setsockopt() on closed socket                        [pp_ssockopt]
+  getsockopt() on closed socket                        [pp_ssockopt]
     close STDIN; 
     setsockopt STDIN, 1,2,3;
     getsockopt STDIN, 1,2;
 
-  get{sock, peer}name() on closed fd           [pp_getpeername]
+  getsockname() on closed socket               [pp_getpeername]
+  getpeername() on closed socket               [pp_getpeername]
     close STDIN; 
     getsockname STDIN;
     getpeername STDIN;
@@ -112,7 +114,7 @@ write STDIN;
 no warnings 'closed' ;
 write STDIN;
 EXPECT
-Write on closed filehandle main::STDIN at - line 6.
+write() on closed filehandle main::STDIN at - line 6.
 ########
 # pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
@@ -148,7 +150,7 @@ printf STDIN "fred";
 no warnings 'closed' ;
 printf STDIN "fred";
 EXPECT
-printf on closed filehandle main::STDIN at - line 4.
+printf() on closed filehandle main::STDIN at - line 4.
 ########
 # pp_sys.c [pp_prtf]
 use warnings 'io' ;
@@ -165,7 +167,7 @@ syswrite STDIN, "fred", 1;
 no warnings 'closed' ;
 syswrite STDIN, "fred", 1;
 EXPECT
-Syswrite on closed filehandle at - line 4.
+syswrite() on closed filehandle at - line 4.
 ########
 # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
 use warnings 'io' ;
@@ -210,16 +212,16 @@ getsockopt STDIN, 1,2;
 getsockname STDIN;
 getpeername STDIN;
 EXPECT
-Send on closed socket at - line 22.
-bind() on closed fd at - line 23.
-connect() on closed fd at - line 24.
-listen() on closed fd at - line 25.
-accept() on closed fd at - line 26.
-shutdown() on closed fd at - line 27.
-[gs]etsockopt() on closed fd at - line 28.
-[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 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.
 ########
 # pp_sys.c [pp_stat]
 use warnings 'newline' ;