optional warning on join(/foo/...) (reworked suggested patch

by Mark-Jason Dominus <mjd@plover.com>)

p4raw-id: //depot/perl@4083

diff --git a/embed.h b/embed.h
index 21f5f36..cfb2aa2 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 (file)
--- 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 (file)
--- 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<join>.  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 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -112,6 +112,13 @@ your signed integers.  See L<perlfunc/unpack>.
 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<join>.  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 (file)
--- 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</split>.
+Beware that unlike C<split>, C<join> doesn't take a pattern as its
+first argument.  Compare L</split>.
 
 =item keys HASH
 

diff --git a/pp.sym b/pp.sym
index c0a8e91..03d36a0 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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.