Increase $PerlIO::via::VERSION to 0.14

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 509aa8e..72d2649 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3379,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;
@@ -3566,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;
                }
@@ -5945,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
@@ -6088,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;
@@ -6266,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];
@@ -6842,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) {
@@ -6858,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);
@@ -6889,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);
@@ -8140,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
            );
 
@@ -8373,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);
@@ -8385,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);
@@ -8436,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;
@@ -8449,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;
@@ -8766,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");
@@ -9225,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)
@@ -9665,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 {
@@ -9692,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);
@@ -9780,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);
@@ -9805,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);
@@ -9892,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);
@@ -9913,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);
@@ -10366,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;
@@ -10466,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.
@@ -10507,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;
@@ -10934,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;
 }