(Retracted by #7943.)

Reserve the short named string operator names.

p4raw-id: //depot/perl@7941

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 9baf175..abe0579 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -3121,6 +3121,13 @@ C<can> may break this.
        eval "sub name { ... }";
     }
 
+=item Subroutine name %s reserved for string operators
+
+(F) Certain string operators can be called with a very similar syntax
+to a function call, and therefore to avoid confusion their names are
+reserved and cannot be used as subroutine names.  The reserved names
+are: C<m s tr y q qq qw qx qr>.
+
 =item Substitution loop
 
 (P) The substitution was looping infinitely.  (Obviously, a substitution

diff --git a/t/op/misc.t b/t/op/misc.t
index aea14c8..6d05046 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -595,3 +595,7 @@ for (@locales) {
     print "$_ $s\n";
 }
 EXPECT
+########
+sub m {}
+EXPECT
+Subroutine name "m" reserved for string operators at - line 1.

diff --git a/toke.c b/toke.c
index 90b5ad5..c759650 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4888,6 +4888,8 @@ Perl_yylex(pTHX)
                if (isIDFIRST_lazy_if(s,UTF) || *s == '\'' ||
                    (*s == ':' && s[1] == ':'))
                {
+                   bool reserved = FALSE;
+
                    PL_expect = XBLOCK;
                    attrful = XATTRBLOCK;
                    /* remember buffer pos'n for later force_word */
@@ -4902,6 +4904,29 @@ Perl_yylex(pTHX)
                    }
                    s = skipspace(d);
                    have_name = TRUE;
+                   switch (tmpbuf[0]) {
+                   case 'm':
+                   case 's':
+                   case 'y':
+                       if (tmpbuf[1] == 0)
+                           reserved = TRUE;
+                       break;
+                   case 'q':
+                       if (tmpbuf[1] == 0 ||
+                           (strchr("qwxr", tmpbuf[1]) && tmpbuf[2] == 0))
+                           reserved = TRUE;
+                       break;
+                   case 't':
+                       if (tmpbuf[1] == 'r' && tmpbuf[2] == 0)
+                           reserved = TRUE;
+                       break;
+                   default:
+                       break;
+                   }
+                   if (reserved)
+                       Perl_croak(aTHX_
+                                  "Subroutine name \"%s\" reserved for string operators",
+                                  tmpbuf);
                }
                else {
                    if (key == KEY_my)