Increase $PerlIO::via::VERSION to 0.14

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 1b26d43..72d2649 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2859,7 +2859,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
         SvTYPE(rv) == SVt_PVCV) && ((stash = CvSTASH(rv)) != NULL))
     {
         const char * const name = HvNAME(stash);
-        if strEQ(name, "_charnames") {
+        if (HvNAMELEN(stash) == sizeof("_charnames")-1
+         && strEQ(name, "_charnames")) {
            return res;
        }
     }
@@ -3378,6 +3379,7 @@ S_scan_const(pTHX_ char *start)
            if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
                isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
            {
+               /* diag_listed_as: \%d better written as $%d */
                Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s);
                *--s = '$';
                break;
@@ -3565,7 +3567,7 @@ S_scan_const(pTHX_ char *start)
                    if (! PL_lex_inpat) {
                        yyerror("Missing right brace on \\N{}");
                    } else {
-                       yyerror("Missing right brace on \\N{} or unescaped left brace after \\N.");
+                       yyerror("Missing right brace on \\N{} or unescaped left brace after \\N");
                    }
                    continue;
                }
@@ -5852,13 +5854,6 @@ Perl_yylex(pTHX)
        if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
            if (*s == '[')
                PL_tokenbuf[0] = '@';
-
-           /* Warn about % where they meant $. */
-           if (*s == '[' || *s == '{') {
-               if (ckWARN(WARN_SYNTAX)) {
-                   S_check_scalar_slice(aTHX_ s);
-               }
-           }
        }
        PL_expect = XOPERATOR;
        force_ident_maybe_lex('%');
@@ -5951,7 +5946,7 @@ Perl_yylex(pTHX)
                }
                sv = newSVpvn_flags(s, len, UTF ? SVf_UTF8 : 0);
                if (*d == '(') {
-                   d = scan_str(d,TRUE,TRUE,FALSE, FALSE);
+                   d = scan_str(d,TRUE,TRUE,FALSE,FALSE,NULL);
                    COPLINE_SET_FROM_MULTI_END;
                    if (!d) {
                        /* MUST advance bufptr here to avoid bogus
@@ -6094,6 +6089,7 @@ Perl_yylex(pTHX)
            TOKEN(0);
        s++;
        if (PL_lex_brackets <= 0)
+           /* diag_listed_as: Unmatched right %s bracket */
            yyerror("Unmatched right square bracket");
        else
            --PL_lex_brackets;
@@ -6272,6 +6268,7 @@ Perl_yylex(pTHX)
       rightbracket:
        s++;
        if (PL_lex_brackets <= 0)
+           /* diag_listed_as: Unmatched right %s bracket */
            yyerror("Unmatched right curly bracket");
        else
            PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
@@ -6848,7 +6845,7 @@ Perl_yylex(pTHX)
        TERM(THING);
 
     case '\'':
-       s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+       s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
        COPLINE_SET_FROM_MULTI_END;
        DEBUG_T( { printbuf("### Saw string before %s\n", s); } );
        if (PL_expect == XOPERATOR) {
@@ -6864,7 +6861,7 @@ Perl_yylex(pTHX)
        TERM(sublex_start());
 
     case '"':
-       s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+       s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
        DEBUG_T( {
            if (s)
                printbuf("### Saw string before %s\n", s);
@@ -6895,7 +6892,7 @@ Perl_yylex(pTHX)
        TERM(sublex_start());
 
     case '`':
-       s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+       s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
        DEBUG_T( { printbuf("### Saw backtick string before %s\n", s); } );
        if (PL_expect == XOPERATOR)
            no_op("Backticks",s);
@@ -7004,8 +7001,10 @@ Perl_yylex(pTHX)
        anydelim = word_takes_any_delimeter(PL_tokenbuf, len);
 
        /* x::* is just a word, unless x is "CORE" */
-       if (!anydelim && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
+       if (!anydelim && *s == ':' && s[1] == ':') {
+           if (strEQ(PL_tokenbuf, "CORE")) goto case_KEY_CORE;
            goto just_a_word;
+       }
 
        d = s;
        while (d < PL_bufend && isSPACE(*d))
@@ -7144,7 +7143,7 @@ Perl_yylex(pTHX)
                }
                gv = NULL;
                gvp = 0;
-               if (hgv && tmp != KEY_x && tmp != KEY_CORE)     /* never ambiguous */
+               if (hgv && tmp != KEY_x)        /* never ambiguous */
                    Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                                   "Ambiguous call resolved as CORE::%s(), "
                                   "qualify as such or use &",
@@ -7750,8 +7749,8 @@ Perl_yylex(pTHX)
            }
            goto just_a_word;
 
-       case KEY_CORE:
-           if (*s == ':' && s[1] == ':') {
+       case_KEY_CORE:
+           {
                STRLEN olen = len;
                d = s;
                s += 2;
@@ -7775,7 +7774,6 @@ Perl_yylex(pTHX)
                    orig_keyword = tmp;
                goto reserved_word;
            }
-           goto just_a_word;
 
        case KEY_abs:
            UNI(OP_ABS);
@@ -8145,7 +8143,7 @@ Perl_yylex(pTHX)
 
        case KEY_glob:
            LOP(
-            orig_keyword==KEY_glob ? (orig_keyword=0, -OP_GLOB) : OP_GLOB,
+            orig_keyword==KEY_glob ? -OP_GLOB : OP_GLOB,
             XTERM
            );
 
@@ -8378,7 +8376,7 @@ Perl_yylex(pTHX)
            LOP(OP_PIPE_OP,XTERM);
 
        case KEY_q:
-           s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+           s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
            COPLINE_SET_FROM_MULTI_END;
            if (!s)
                missingterm(NULL);
@@ -8390,7 +8388,7 @@ Perl_yylex(pTHX)
 
        case KEY_qw: {
            OP *words = NULL;
-           s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+           s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
            COPLINE_SET_FROM_MULTI_END;
            if (!s)
                missingterm(NULL);
@@ -8441,7 +8439,7 @@ Perl_yylex(pTHX)
        }
 
        case KEY_qq:
-           s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+           s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
            if (!s)
                missingterm(NULL);
            pl_yylval.ival = OP_STRINGIFY;
@@ -8454,7 +8452,7 @@ Perl_yylex(pTHX)
            TERM(sublex_start());
 
        case KEY_qx:
-           s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+           s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
            if (!s)
                missingterm(NULL);
            pl_yylval.ival = OP_BACKTICK;
@@ -8771,7 +8769,7 @@ Perl_yylex(pTHX)
 
                /* Look for a prototype */
                if (*s == '(') {
-                   s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+                   s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
                    COPLINE_SET_FROM_MULTI_END;
                    if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
@@ -9230,7 +9228,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
                            newSVpvs(":full"),
                            newSVpvs(":short"),
                            NULL);
-           SPAGAIN;
+            assert(sp == PL_stack_sp);
            table = GvHV(PL_hintgv);
            if (table
                && (PL_hints & HINT_LOCALIZE_HH)
@@ -9670,6 +9668,7 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
            yyerror(Perl_form(aTHX_ "Regexp modifiers \"/%c\" and \"/%c\" are mutually exclusive", *charset, c));
        }
        else if (c == 'a') {
+  /* diag_listed_as: Regexp modifier "/%c" may appear a maximum of twice */
            yyerror("Regexp modifier \"/a\" may appear a maximum of twice");
        }
        else {
@@ -9697,7 +9696,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
     PERL_ARGS_ASSERT_SCAN_PAT;
 
     s = scan_str(start,!!PL_madskills,FALSE, (PL_in_eval & EVAL_RE_REPARSING),
-                       TRUE /* look for escaped bracketed metas */ );
+                       TRUE /* look for escaped bracketed metas */, NULL);
 
     if (!s) {
        const char * const delimiter = skipspace(start);
@@ -9785,19 +9784,19 @@ S_scan_subst(pTHX_ char *start)
 #ifdef PERL_MAD
     char *modstart;
 #endif
+    char *t;
 
     PERL_ARGS_ASSERT_SCAN_SUBST;
 
     pl_yylval.ival = OP_NULL;
 
     s = scan_str(start,!!PL_madskills,FALSE,FALSE,
-                 TRUE /* look for escaped bracketed metas */ );
+                 TRUE /* look for escaped bracketed metas */, &t);
 
     if (!s)
        Perl_croak(aTHX_ "Substitution pattern not terminated");
 
-    if (s[-1] == PL_multi_open)
-       s--;
+    s = t;
 #ifdef PERL_MAD
     if (PL_madskills) {
        CURMAD('q', PL_thisopen);
@@ -9810,7 +9809,7 @@ S_scan_subst(pTHX_ char *start)
 
     first_start = PL_multi_start;
     first_line = CopLINE(PL_curcop);
-    s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+    s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
     if (!s) {
        if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
@@ -9897,17 +9896,17 @@ S_scan_trans(pTHX_ char *start)
 #ifdef PERL_MAD
     char *modstart;
 #endif
+    char *t;
 
     PERL_ARGS_ASSERT_SCAN_TRANS;
 
     pl_yylval.ival = OP_NULL;
 
-    s = scan_str(start,!!PL_madskills,FALSE,FALSE, FALSE);
+    s = scan_str(start,!!PL_madskills,FALSE,FALSE,FALSE,&t);
     if (!s)
        Perl_croak(aTHX_ "Transliteration pattern not terminated");
 
-    if (s[-1] == PL_multi_open)
-       s--;
+    s = t;
 #ifdef PERL_MAD
     if (PL_madskills) {
        CURMAD('q', PL_thisopen);
@@ -9918,7 +9917,7 @@ S_scan_trans(pTHX_ char *start)
     }
 #endif
 
-    s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+    s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
     if (!s) {
        if (PL_lex_stuff) {
            SvREFCNT_dec(PL_lex_stuff);
@@ -10371,7 +10370,7 @@ S_scan_inputsymbol(pTHX_ char *start)
 
     if (d - PL_tokenbuf != len) {
        pl_yylval.ival = OP_GLOB;
-       s = scan_str(start,!!PL_madskills,FALSE,FALSE, FALSE);
+       s = scan_str(start,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
        if (!s)
           Perl_croak(aTHX_ "Glob not terminated");
        return s;
@@ -10471,6 +10470,11 @@ intro_sym:
        deprecate_escaped_meta  issue a deprecation warning for cer-
                                tain paired metacharacters that appear
                                escaped within it
+       delimp                  if non-null, this is set to the position of
+                               the closing delimiter, or just after it if
+                               the closing and opening delimiters differ
+                               (i.e., the opening delimiter of a substitu-
+                               tion replacement)
    returns: position to continue reading from buffer
    side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
        updates the read buffer.
@@ -10512,7 +10516,7 @@ intro_sym:
 
 STATIC char *
 S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse,
-                bool deprecate_escaped_meta
+                bool deprecate_escaped_meta, char **delimp
     )
 {
     dVAR;
@@ -10939,6 +10943,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse,
        PL_sublex_info.repl = sv;
     else
        PL_lex_stuff = sv;
+    if (delimp) *delimp = PL_multi_open == PL_multi_close ? s-termlen : s;
     return s;
 }