From eb6e2d6f1e269264d7937d1be23cbbe0b6820902 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Mon, 6 Sep 1999 00:10:40 +0000 Subject: [PATCH] optional warning on join(/foo/...) (reworked suggested patch by Mark-Jason Dominus ) p4raw-id: //depot/perl@4083 --- embed.h | 4 ++++ objXSUB.h | 4 ++++ op.c | 17 +++++++++++++++++ opcode.h | 2 +- opcode.pl | 2 +- perlapi.c | 7 +++++++ pod/perldelta.pod | 7 +++++++ pod/perldiag.pod | 7 +++++++ pod/perlfunc.pod | 3 ++- pp.sym | 1 + pp_proto.h | 1 + t/pragma/warn/op | 11 +++++++++-- 12 files changed, 61 insertions(+), 5 deletions(-) diff --git a/embed.h b/embed.h index 21f5f36..cfb2aa2 100644 --- a/embed.h +++ b/embed.h @@ -1023,6 +1023,7 @@ #define ck_glob Perl_ck_glob #define ck_grep Perl_ck_grep #define ck_index Perl_ck_index +#define ck_join Perl_ck_join #define ck_lengthconst Perl_ck_lengthconst #define ck_lfun Perl_ck_lfun #define ck_listiob Perl_ck_listiob @@ -2350,6 +2351,7 @@ #define ck_glob(a) Perl_ck_glob(aTHX_ a) #define ck_grep(a) Perl_ck_grep(aTHX_ a) #define ck_index(a) Perl_ck_index(aTHX_ a) +#define ck_join(a) Perl_ck_join(aTHX_ a) #define ck_lengthconst(a) Perl_ck_lengthconst(aTHX_ a) #define ck_lfun(a) Perl_ck_lfun(aTHX_ a) #define ck_listiob(a) Perl_ck_listiob(aTHX_ a) @@ -4583,6 +4585,8 @@ #define ck_grep Perl_ck_grep #define Perl_ck_index CPerlObj::Perl_ck_index #define ck_index Perl_ck_index +#define Perl_ck_join CPerlObj::Perl_ck_join +#define ck_join Perl_ck_join #define Perl_ck_lengthconst CPerlObj::Perl_ck_lengthconst #define ck_lengthconst Perl_ck_lengthconst #define Perl_ck_lfun CPerlObj::Perl_ck_lfun diff --git a/objXSUB.h b/objXSUB.h index abb9f39..02ad66e 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -3650,6 +3650,10 @@ #define Perl_ck_index pPerl->Perl_ck_index #undef ck_index #define ck_index Perl_ck_index +#undef Perl_ck_join +#define Perl_ck_join pPerl->Perl_ck_join +#undef ck_join +#define ck_join Perl_ck_join #undef Perl_ck_lengthconst #define Perl_ck_lengthconst pPerl->Perl_ck_lengthconst #undef ck_lengthconst diff --git a/op.c b/op.c index ae477d8..3f5541c 100644 --- a/op.c +++ b/op.c @@ -5717,6 +5717,23 @@ Perl_ck_split(pTHX_ OP *o) } OP * +Perl_ck_join(pTHX_ OP *o) +{ + if (ckWARN(WARN_SYNTAX)) { + OP *kid = cLISTOPo->op_first->op_sibling; + if (kid && kid->op_type == OP_MATCH) { + char *pmstr = "STRING"; + if (kPMOP->op_pmregexp) + pmstr = kPMOP->op_pmregexp->precomp; + Perl_warner(aTHX_ WARN_SYNTAX, + "/%s/ should probably be written as \"%s\"", + pmstr, pmstr); + } + } + return ck_fun(o); +} + +OP * Perl_ck_subr(pTHX_ OP *o) { dTHR; diff --git a/opcode.h b/opcode.h index 7ca8d48..9527638 100644 --- a/opcode.h +++ b/opcode.h @@ -1234,7 +1234,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { Perl_ck_fun, /* unpack */ Perl_ck_fun, /* pack */ Perl_ck_split, /* split */ - Perl_ck_fun, /* join */ + Perl_ck_join, /* join */ Perl_ck_null, /* list */ Perl_ck_null, /* lslice */ Perl_ck_fun, /* anonlist */ diff --git a/opcode.pl b/opcode.pl index 5b666d3..8eadbe7 100755 --- a/opcode.pl +++ b/opcode.pl @@ -508,7 +508,7 @@ hslice hash slice ck_null m@ H L unpack unpack ck_fun @ S S pack pack ck_fun mst@ S L split split ck_split t@ S S S -join join ck_fun msT@ S L +join join ck_join msT@ S L # List operators. diff --git a/perlapi.c b/perlapi.c index 6860b18..0e54575 100644 --- a/perlapi.c +++ b/perlapi.c @@ -4981,6 +4981,13 @@ Perl_ck_index(pTHXo_ OP *o) return ((CPerlObj*)pPerl)->Perl_ck_index(o); } +#undef Perl_ck_join +OP * +Perl_ck_join(pTHXo_ OP *o) +{ + return ((CPerlObj*)pPerl)->Perl_ck_join(o); +} + #undef Perl_ck_lengthconst OP * Perl_ck_lengthconst(pTHXo_ OP *o) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a228530..cf97559 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -725,6 +725,13 @@ of a subroutine attribute, and it wasn't a semicolon or the start of a block. Perhaps you terminated the parameter list of the previous attribute too soon. +=item /%s/ should probably be written as "%s" + +(W) You have used a pattern where Perl expected to find a string, +like in the first argument to C. Perl will treat the true +or false result of matching the pattern against $_ as the string, +which is probably not what you had in mind. + =head1 Obsolete Diagnostics Todo. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 10808ff..1c07a31 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -112,6 +112,13 @@ your signed integers. See L. by Perl. This combination appears in an interpolated variable or a C<'>-delimited regular expression. +=item /%s/ should probably be written as "%s" + +(W) You have used a pattern where Perl expected to find a string, +like in the first argument to C. Perl will treat the true +or false result of matching the pattern against $_ as the string, +which is probably not what you had in mind. + =item %s (...) interpreted as function (W) You've run afoul of the rule that says that any list operator followed diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index d420059..f830478 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -2064,7 +2064,8 @@ separated by the value of EXPR, and returns that new string. Example: $rec = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell); -See L. +Beware that unlike C, C doesn't take a pattern as its +first argument. Compare L. =item keys HASH diff --git a/pp.sym b/pp.sym index c0a8e91..03d36a0 100644 --- a/pp.sym +++ b/pp.sym @@ -19,6 +19,7 @@ Perl_ck_fun_locale Perl_ck_glob Perl_ck_grep Perl_ck_index +Perl_ck_join Perl_ck_lengthconst Perl_ck_lfun Perl_ck_listiob diff --git a/pp_proto.h b/pp_proto.h index 44f1658..3fa494e 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -18,6 +18,7 @@ PERL_CKDEF(Perl_ck_fun_locale) PERL_CKDEF(Perl_ck_glob) PERL_CKDEF(Perl_ck_grep) PERL_CKDEF(Perl_ck_index) +PERL_CKDEF(Perl_ck_join) PERL_CKDEF(Perl_ck_lengthconst) PERL_CKDEF(Perl_ck_lfun) PERL_CKDEF(Perl_ck_listiob) diff --git a/t/pragma/warn/op b/t/pragma/warn/op index f6e5e14..07ec67c 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -95,6 +95,9 @@ defined(%hash) is deprecated (Maybe you should just omit the defined()?) my %h ; defined %h ; + + /---/ should probably be written as "---" + join(/---/, @foo); Mandatory Warnings ------------------ @@ -107,8 +110,6 @@ oops: oopsAV [oopsAV] TODO oops: oopsHV [oopsHV] TODO - - __END__ # op.c @@ -787,3 +788,9 @@ EXPECT Prototype mismatch: sub main::fred () vs ($) at - line 4. Prototype mismatch: sub main::freD () vs ($) at - line 11. Prototype mismatch: sub main::FRED () vs ($) at - line 14. +######## +# op.c +use warnings 'syntax' ; +join /---/, 'x', 'y', 'z'; +EXPECT +/---/ should probably be written as "---" at - line 3. -- 2.7.4