From: Gurusamy Sarathy Date: Tue, 28 Dec 1999 01:20:39 +0000 (+0000) Subject: partly fix perldiag regressions identified by Tom Christiansen X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9a7dcd9c47ba9757eae19d3e3965b387f5197198;hp=a67e862a325388c91a8a3eee7f587636c9a77259;p=p5sagit%2Fp5-mst-13.2.git partly fix perldiag regressions identified by Tom Christiansen p4raw-id: //depot/perl@4709 --- diff --git a/doio.c b/doio.c index 37e061a..c13228a 100644 --- 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)); } } diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index d405e36..aff9b55 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -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"; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index f47ae5a..20ab4d9 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -280,7 +280,7 @@ the string being unpacked. See L. (F) You wrote CfileE> when you should have written C. -=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. @@ -518,7 +518,7 @@ likely depends on its correct operation, Perl just gave up. (4294967295) and therefore non-portable between systems. See L 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. @@ -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. @@ -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 for information on I.) -=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. @@ -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. (F) While under the C 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. @@ -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. +See L and L. =item \1 better written as $1 diff --git a/pp_hot.c b/pp_hot.c index 743913d..e83f0b8 100644 --- 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)); } } diff --git a/pp_sys.c b/pp_sys.c index 96ba78b..b0227a5 100644 --- 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; diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint index b7c64c3..db54f31 100644 --- a/t/pragma/warn/4lint +++ b/t/pragma/warn/4lint @@ -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 diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index 4706aeb..57dd993 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -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' ; diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 379918b..7e19dc5 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -9,7 +9,7 @@ Filehandle %s opened only for output [pp_print] print ; - 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] <; glob failed (child exited with status %d%s) [Perl_do_readline] < ; no warnings 'closed' ; $a = ; 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' ; diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index 651cdf9..ea4b536 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -8,7 +8,7 @@ . write STDIN; - Write on closed filehandle %s [pp_leavewrite] + write() on closed filehandle %s [pp_leavewrite] format STDIN = . close STDIN; @@ -23,45 +23,47 @@ $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' ;