toke.c: deprecation warning for ' as a package separator

First stage of RFC 0015.

This also changes the warning for ' as package separator in
quoted strings to also be a deprecation warning.

1 files changed, 44 insertions, 38 deletions

diff --git a/toke.c b/toke.c
index afe245bf7e..c4585a528c 100644
--- a/toke.c
+++ b/toke.c
@@ -2258,7 +2258,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack)
     if (   isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)
         || (allow_pack && *s == ':' && s[1] == ':') )
     {
-        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
+        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len, allow_pack);
         if (check_keyword) {
           char *s2 = PL_tokenbuf;
           STRLEN len2 = len;
@@ -4670,7 +4670,7 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv)
         return *s == '(' ? METHCALL : METHCALL0;
     }
 
-    s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
+    s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len, FALSE);
     /* start is the beginning of the possible filehandle/object,
      * and s is the end of it
      * tmpbuf is a copy of it (but with single quotes as double colons)
@@ -5299,7 +5299,7 @@ yyl_dollar(pTHX_ char *s)
                     if (isIDFIRST_lazy_if_safe(t, PL_bufend, UTF)) {
                         STRLEN len;
                         t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE,
-                                        &len);
+                                      &len, TRUE);
                         while (isSPACE(*t))
                             t++;
                         if (  *t == ';'
@@ -5332,7 +5332,7 @@ yyl_dollar(pTHX_ char *s)
                 char tmpbuf[sizeof PL_tokenbuf];
                 int t2;
                 STRLEN len;
-                scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
+                scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len, FALSE);
                 if ((t2 = keyword(tmpbuf, len, 0))) {
                     /* binary operators exclude handle interpretations */
                     switch (t2) {
@@ -5401,7 +5401,7 @@ yyl_sub(pTHX_ char *s, const int key)
 
         PL_expect = XATTRBLOCK;
         d = scan_word(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE,
-                      &len);
+                      &len, TRUE);
         if (key == KEY_format)
             format_name = S_newSV_maybe_utf8(aTHX_ s, d - s);
         *PL_tokenbuf = '&';
@@ -5980,7 +5980,7 @@ yyl_colon(pTHX_ char *s)
             I32 tmp;
             SV *sv;
             STRLEN len;
-            char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+            char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE);
             if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len, 0))) {
                 if (tmp < 0) tmp = -tmp;
                 switch (tmp) {
@@ -6161,7 +6161,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack)
         if (d < PL_bufend && isIDFIRST_lazy_if_safe(d, PL_bufend, UTF)) {
             STRLEN len;
             d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
-                          FALSE, &len);
+                          FALSE, &len, FALSE);
             while (d < PL_bufend && SPACE_OR_TAB(*d))
                 d++;
             if (*d == '}') {
@@ -7006,7 +7006,7 @@ yyl_foreach(pTHX_ char *s)
             /* skip optional package name, as in "for my abc $x (..)" */
             if (UNLIKELY(isIDFIRST_lazy_if_safe(p, PL_bufend, UTF))) {
                 STRLEN len;
-                p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
+                p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len, TRUE);
                 p = skipspace(p);
                 paren_is_valid = FALSE;
             }
@@ -7038,7 +7038,7 @@ yyl_do(pTHX_ char *s, I32 orig_keyword)
         STRLEN len;
         *PL_tokenbuf = '&';
         d = scan_word(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
-                      1, &len);
+                      1, &len, TRUE);
         if (len && memNEs(PL_tokenbuf+1, len, "CORE")
          && !keyword(PL_tokenbuf + 1, len, 0)) {
             SSize_t off = s-SvPVX(PL_linestr);
@@ -7073,7 +7073,7 @@ yyl_my(pTHX_ char *s, I32 my)
     s = skipspace(s);
     if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) {
         STRLEN len;
-        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
+        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len, TRUE);
         if (memEQs(PL_tokenbuf, len, "sub"))
             return yyl_sub(aTHX_ s, my);
         PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);
@@ -7546,7 +7546,7 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c)
     if (*s == '\'' || (*s == ':' && s[1] == ':')) {
         STRLEN morelen;
         s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
-                      TRUE, &morelen);
+                      TRUE, &morelen, TRUE);
         if (no_op_error) {
             no_op("Bareword",s);
             no_op_error = FALSE;
@@ -8263,7 +8263,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
         s = skipspace(s);
         if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) {
             const char *t;
-            char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+            char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE);
             for (t=d; isSPACE(*t);)
                 t++;
             if ( *t && memCHRs("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
@@ -8705,7 +8705,7 @@ yyl_key_core(pTHX_ char *s, STRLEN len, struct code c)
     STRLEN olen = len;
     char *d = s;
     s += 2;
-    s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+    s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE);
     if ((*s == ':' && s[1] == ':')
         || (!(key = keyword(PL_tokenbuf, len, 1)) && *s == '\''))
     {
@@ -8784,7 +8784,7 @@ yyl_keylookup(pTHX_ char *s, GV *gv)
     c.gv = gv;
 
     PL_bufptr = s;
-    s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
+    s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len, FALSE);
 
     /* Some keywords can be followed by any delimiter, including ':' */
     anydelim = word_takes_any_delimiter(PL_tokenbuf, len);
@@ -10156,29 +10156,35 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package,
         else
             break;
     }
-    if (UNLIKELY(tick_warn && saw_tick && PL_lex_state == LEX_INTERPNORMAL
-              && !PL_lex_brackets && ckWARN_d(WARN_SYNTAX))) {
-        char *this_d;
-        char *d2;
-        Newx(this_d, *s - olds + saw_tick + 2, char); /* +2 for $# */
-        d2 = this_d;
-        SAVEFREEPV(this_d);
-        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                         "Old package separator used in string");
-        if (olds[-1] == '#')
-            *d2++ = olds[-2];
-        *d2++ = olds[-1];
-        while (olds < *s) {
-            if (*olds == '\'') {
-                *d2++ = '\\';
-                *d2++ = *olds++;
+    if (UNLIKELY(saw_tick && tick_warn && ckWARN2_d(WARN_SYNTAX, WARN_DEPRECATED))) {
+        if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
+            char *this_d;
+            char *d2;
+            Newx(this_d, *s - olds + saw_tick + 2, char); /* +2 for $# */
+            d2 = this_d;
+            SAVEFREEPV(this_d);
+
+            Perl_warner(aTHX_ packWARN2(WARN_SYNTAX, WARN_DEPRECATED),
+                        "Old package separator used in string");
+            if (olds[-1] == '#')
+                *d2++ = olds[-2];
+            *d2++ = olds[-1];
+            while (olds < *s) {
+                if (*olds == '\'') {
+                    *d2++ = '\\';
+                    *d2++ = *olds++;
+                }
+                else
+                    *d2++ = *olds++;
             }
-            else
-                *d2++ = *olds++;
+            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                        "\t(Did you mean \"%" UTF8f "\" instead?)\n",
+                        UTF8fARG(is_utf8, d2-this_d, this_d));
+        }
+        else {
+            Perl_warner(aTHX_ packWARN2(WARN_SYNTAX, WARN_DEPRECATED),
+                        "Old package separator \"'\" deprecated");
         }
-        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                         "\t(Did you mean \"%" UTF8f "\" instead?)\n",
-                          UTF8fARG(is_utf8, d2-this_d, this_d));
     }
     return;
 }
@@ -10187,7 +10193,7 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package,
    *slp
    */
 char *
-Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
+Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp, bool warn_tick)
 {
     char *d = dest;
     char * const e = d + destlen - 3;  /* two-character token, ending NUL */
@@ -10195,7 +10201,7 @@ Perl_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STR
 
     PERL_ARGS_ASSERT_SCAN_WORD;
 
-    parse_ident(&s, &d, e, allow_package, is_utf8, TRUE, FALSE);
+    parse_ident(&s, &d, e, allow_package, is_utf8, TRUE, warn_tick);
     *d = '\0';
     *slp = d - dest;
     return s;
@@ -13678,7 +13684,7 @@ Perl_parse_label(pTHX_ U32 flags)
         t = s = PL_bufptr;
         if (!isIDFIRST_lazy_if_safe(s, PL_bufend, UTF))
             goto no_label;
-        t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen);
+        t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen, FALSE);
         if (word_takes_any_delimiter(s, wlen))
             goto no_label;
         bufptr_pos = s - SvPVX(PL_linestr);