This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
disable lexing of (?{}) within \Q, \U etc
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index a85b698..a823597 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -133,7 +133,7 @@ static const char ident_too_long[] = "Identifier too long";
 #ifdef USE_UTF8_SCRIPTS
 #   define UTF (!IN_BYTES)
 #else
 #ifdef USE_UTF8_SCRIPTS
 #   define UTF (!IN_BYTES)
 #else
-#   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
+#   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || ( !(PL_parser->lex_flags & LEX_IGNORE_UTF8_HINTS) && (PL_hints & HINT_UTF8)))
 #endif
 
 /* The maximum number of characters preceding the unrecognized one to display */
 #endif
 
 /* The maximum number of characters preceding the unrecognized one to display */
@@ -148,6 +148,9 @@ static const char ident_too_long[] = "Identifier too long";
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
 /* LEX_* are values for PL_lex_state, the state of the lexer.
  * They are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
+ *
+ * These values refer to the various states within a sublex parse,
+ * i.e. within a double quotish string
  */
 
 /* #define LEX_NOTPARSING              11 is done in perl.h. */
  */
 
 /* #define LEX_NOTPARSING              11 is done in perl.h. */
@@ -285,6 +288,10 @@ static const char* const lex_state_names[] = {
        }
 #define UNI(f)    UNI2(f,XTERM)
 #define UNIDOR(f) UNI2(f,XTERMORDORDOR)
        }
 #define UNI(f)    UNI2(f,XTERM)
 #define UNIDOR(f) UNI2(f,XTERMORDORDOR)
+#define UNIPROTO(f,optional) { \
+       if (optional) PL_last_uni = PL_oldbufptr; \
+       OPERATOR(f); \
+       }
 
 #define UNIBRACK(f) { \
        pl_yylval.ival = f; \
 
 #define UNIBRACK(f) { \
        pl_yylval.ival = f; \
@@ -355,7 +362,7 @@ static struct debug_tokens {
     { GIVEN,           TOKENTYPE_IVAL,         "GIVEN" },
     { HASHBRACK,       TOKENTYPE_NONE,         "HASHBRACK" },
     { IF,              TOKENTYPE_IVAL,         "IF" },
     { GIVEN,           TOKENTYPE_IVAL,         "GIVEN" },
     { HASHBRACK,       TOKENTYPE_NONE,         "HASHBRACK" },
     { IF,              TOKENTYPE_IVAL,         "IF" },
-    { LABEL,           TOKENTYPE_PVAL,         "LABEL" },
+    { LABEL,           TOKENTYPE_OPVAL,        "LABEL" },
     { LOCAL,           TOKENTYPE_IVAL,         "LOCAL" },
     { LOOPEX,          TOKENTYPE_OPNUM,        "LOOPEX" },
     { LSTOP,           TOKENTYPE_OPNUM,        "LSTOP" },
     { LOCAL,           TOKENTYPE_IVAL,         "LOCAL" },
     { LOOPEX,          TOKENTYPE_OPNUM,        "LOOPEX" },
     { LSTOP,           TOKENTYPE_OPNUM,        "LSTOP" },
@@ -533,24 +540,28 @@ S_no_op(pTHX_ const char *const what, char *s)
        s = oldbp;
     else
        PL_bufptr = s;
        s = oldbp;
     else
        PL_bufptr = s;
-    yywarn(Perl_form(aTHX_ "%s found where operator expected", what));
+    yywarn(Perl_form(aTHX_ "%s found where operator expected", what), UTF ? SVf_UTF8 : 0);
     if (ckWARN_d(WARN_SYNTAX)) {
        if (is_first)
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                    "\t(Missing semicolon on previous line?)\n");
        else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) {
            const char *t;
     if (ckWARN_d(WARN_SYNTAX)) {
        if (is_first)
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                    "\t(Missing semicolon on previous line?)\n");
        else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) {
            const char *t;
-           for (t = PL_oldoldbufptr; (isALNUM_lazy_if(t,UTF) || *t == ':'); t++)
+           for (t = PL_oldoldbufptr; (isALNUM_lazy_if(t,UTF) || *t == ':');
+                                                            t += UTF ? UTF8SKIP(t) : 1)
                NOOP;
            if (t < PL_bufptr && isSPACE(*t))
                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                NOOP;
            if (t < PL_bufptr && isSPACE(*t))
                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                       "\t(Do you need to predeclare %.*s?)\n",
-                   (int)(t - PL_oldoldbufptr), PL_oldoldbufptr);
+                       "\t(Do you need to predeclare %"SVf"?)\n",
+                   SVfARG(newSVpvn_flags(PL_oldoldbufptr, (STRLEN)(t - PL_oldoldbufptr),
+                                   SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
        }
        else {
            assert(s >= oldbp);
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
        }
        else {
            assert(s >= oldbp);
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                   "\t(Missing operator before %.*s?)\n", (int)(s - oldbp), oldbp);
+                   "\t(Missing operator before %"SVf"?)\n",
+                    SVfARG(newSVpvn_flags(oldbp, (STRLEN)(s - oldbp),
+                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
        }
     }
     PL_bufptr = oldbp;
        }
     }
     PL_bufptr = oldbp;
@@ -591,6 +602,8 @@ S_missingterm(pTHX_ char *s)
     Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
 }
 
     Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
 }
 
+#include "feature.h"
+
 /*
  * Check whether the named feature is enabled.
  */
 /*
  * Check whether the named feature is enabled.
  */
@@ -598,16 +611,18 @@ bool
 Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
 {
     dVAR;
 Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
 {
     dVAR;
-    HV * const hinthv = GvHV(PL_hintgv);
     char he_name[8 + MAX_FEATURE_LEN] = "feature_";
 
     PERL_ARGS_ASSERT_FEATURE_IS_ENABLED;
 
     char he_name[8 + MAX_FEATURE_LEN] = "feature_";
 
     PERL_ARGS_ASSERT_FEATURE_IS_ENABLED;
 
+    assert(CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM);
+
     if (namelen > MAX_FEATURE_LEN)
        return FALSE;
     memcpy(&he_name[8], name, namelen);
 
     if (namelen > MAX_FEATURE_LEN)
        return FALSE;
     memcpy(&he_name[8], name, namelen);
 
-    return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
+    return cBOOL(cop_hints_fetch_pvn(PL_curcop, he_name, 8 + namelen, 0,
+                                    REFCOUNTED_HE_EXISTS));
 }
 
 /*
 }
 
 /*
@@ -669,24 +684,28 @@ from which code will be read to be parsed.  If both are non-null, the
 code in I<line> comes first and must consist of complete lines of input,
 and I<rsfp> supplies the remainder of the source.
 
 code in I<line> comes first and must consist of complete lines of input,
 and I<rsfp> supplies the remainder of the source.
 
-The I<flags> parameter is reserved for future use, and must always
-be zero, except for one flag that is currently reserved for perl's internal
-use.
+The I<flags> parameter is reserved for future use.  Currently it is only
+used by perl internally, so extensions should always pass zero.
 
 =cut
 */
 
 /* LEX_START_SAME_FILTER indicates that this is not a new file, so it
 
 =cut
 */
 
 /* LEX_START_SAME_FILTER indicates that this is not a new file, so it
-   can share filters with the current parser. */
+   can share filters with the current parser.
+   LEX_START_DONT_CLOSE indicates that the file handle wasn't opened by the
+   caller, hence isn't owned by the parser, so shouldn't be closed on parser
+   destruction. This is used to handle the case of defaulting to reading the
+   script from the standard input because no filename was given on the command
+   line (without getting confused by situation where STDIN has been closed, so
+   the script handle is opened on fd 0)  */
 
 void
 Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
 {
     dVAR;
     const char *s = NULL;
 
 void
 Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
 {
     dVAR;
     const char *s = NULL;
-    STRLEN len;
     yy_parser *parser, *oparser;
     yy_parser *parser, *oparser;
-    if (flags && flags != LEX_START_SAME_FILTER)
+    if (flags && flags & ~LEX_START_FLAGS)
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start");
 
     /* create and initialise a parser */
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start");
 
     /* create and initialise a parser */
@@ -717,25 +736,27 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
     parser->rsfp = rsfp;
     parser->rsfp_filters =
       !(flags & LEX_START_SAME_FILTER) || !oparser
     parser->rsfp = rsfp;
     parser->rsfp_filters =
       !(flags & LEX_START_SAME_FILTER) || !oparser
-        ? newAV()
-        : MUTABLE_AV(SvREFCNT_inc(oparser->rsfp_filters));
+        ? NULL
+        : MUTABLE_AV(SvREFCNT_inc(
+            oparser->rsfp_filters
+             ? oparser->rsfp_filters
+             : (oparser->rsfp_filters = newAV())
+          ));
 
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
     *parser->lex_casestack = '\0';
 
     if (line) {
 
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
     *parser->lex_casestack = '\0';
 
     if (line) {
+       STRLEN len;
        s = SvPV_const(line, len);
        s = SvPV_const(line, len);
+       parser->linestr = flags & LEX_START_COPIED
+                           ? SvREFCNT_inc_simple_NN(line)
+                           : newSVpvn_flags(s, len, SvUTF8(line));
+       if (!len || s[len-1] != ';')
+           sv_catpvs(parser->linestr, "\n;");
     } else {
     } else {
-       len = 0;
-    }
-
-    if (!len) {
        parser->linestr = newSVpvs("\n;");
        parser->linestr = newSVpvs("\n;");
-    } else {
-       parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
-       if (s[len-1] != ';')
-           sv_catpvs(parser->linestr, "\n;");
     }
     parser->oldoldbufptr =
        parser->oldbufptr =
     }
     parser->oldoldbufptr =
        parser->oldbufptr =
@@ -743,8 +764,10 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
        parser->linestart = SvPVX(parser->linestr);
     parser->bufend = parser->bufptr + SvCUR(parser->linestr);
     parser->last_lop = parser->last_uni = NULL;
        parser->linestart = SvPVX(parser->linestr);
     parser->bufend = parser->bufptr + SvCUR(parser->linestr);
     parser->last_lop = parser->last_uni = NULL;
+    parser->lex_flags = flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES
+                                |LEX_DONT_CLOSE_RSFP);
 
 
-    parser->in_pod = 0;
+    parser->in_pod = parser->filtered = 0;
 }
 
 
 }
 
 
@@ -758,7 +781,7 @@ Perl_parser_free(pTHX_  const yy_parser *parser)
     PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);
 
     PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);
 
-    if (parser->rsfp == PerlIO_stdin())
+    if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
        PerlIO_clearerr(parser->rsfp);
     else if (parser->rsfp && (!parser->old_parser ||
                (parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
        PerlIO_clearerr(parser->rsfp);
     else if (parser->rsfp && (!parser->old_parser ||
                (parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
@@ -1262,7 +1285,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
     }
     if (flags & LEX_FAKE_EOF) {
        goto eof;
     }
     if (flags & LEX_FAKE_EOF) {
        goto eof;
-    } else if (!PL_parser->rsfp) {
+    } else if (!PL_parser->rsfp && !PL_parser->filtered) {
        got_some = 0;
     } else if (filter_gets(linestr, old_bufend_pos)) {
        got_some = 1;
        got_some = 0;
     } else if (filter_gets(linestr, old_bufend_pos)) {
        got_some = 1;
@@ -1274,12 +1297,12 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
        /* End of real input.  Close filehandle (unless it was STDIN),
         * then add implicit termination.
         */
        /* End of real input.  Close filehandle (unless it was STDIN),
         * then add implicit termination.
         */
-       if ((PerlIO*)PL_parser->rsfp == PerlIO_stdin())
+       if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
            PerlIO_clearerr(PL_parser->rsfp);
        else if (PL_parser->rsfp)
            (void)PerlIO_close(PL_parser->rsfp);
        PL_parser->rsfp = NULL;
            PerlIO_clearerr(PL_parser->rsfp);
        else if (PL_parser->rsfp)
            (void)PerlIO_close(PL_parser->rsfp);
        PL_parser->rsfp = NULL;
-       PL_parser->in_pod = 0;
+       PL_parser->in_pod = PL_parser->filtered = 0;
 #ifdef PERL_MAD
        if (PL_madskills && !PL_in_eval && (PL_minus_p || PL_minus_n))
            PL_faketokens = 1;
 #ifdef PERL_MAD
        if (PL_madskills && !PL_in_eval && (PL_minus_p || PL_minus_n))
            PL_faketokens = 1;
@@ -1584,7 +1607,7 @@ S_incline(pTHX_ const char *s)
            tmplen = 0;
        }
 
            tmplen = 0;
        }
 
-       if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
+       if (!PL_rsfp && !PL_parser->filtered) {
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
            /* However, the long form of evals is only turned on by the
            /* must copy *{"::_<(eval N)[oldfilename:L]"}
             * to *{"::_<newfilename"} */
            /* However, the long form of evals is only turned on by the
@@ -2180,11 +2203,13 @@ S_force_version(pTHX_ char *s, int guessing)
         if (*d == ';' || isSPACE(*d) || *d == '{' || *d == '}' || !*d) {
            SV *ver;
 #ifdef USE_LOCALE_NUMERIC
         if (*d == ';' || isSPACE(*d) || *d == '{' || *d == '}' || !*d) {
            SV *ver;
 #ifdef USE_LOCALE_NUMERIC
-           char *loc = setlocale(LC_NUMERIC, "C");
+           char *loc = savepv(setlocale(LC_NUMERIC, NULL));
+           setlocale(LC_NUMERIC, "C");
 #endif
             s = scan_num(s, &pl_yylval);
 #ifdef USE_LOCALE_NUMERIC
            setlocale(LC_NUMERIC, loc);
 #endif
             s = scan_num(s, &pl_yylval);
 #ifdef USE_LOCALE_NUMERIC
            setlocale(LC_NUMERIC, loc);
+           Safefree(loc);
 #endif
             version = pl_yylval.opval;
            ver = cSVOPx(version)->op_sv;
 #endif
             version = pl_yylval.opval;
            ver = cSVOPx(version)->op_sv;
@@ -2327,14 +2352,10 @@ S_tokeq(pTHX_ SV *sv)
  * converting things like "\u\Lgnat" into ucfirst(lc("gnat")).  They
  * interact with PL_lex_state, and create fake ( ... ) argument lists
  * to handle functions and concatenation.
  * converting things like "\u\Lgnat" into ucfirst(lc("gnat")).  They
  * interact with PL_lex_state, and create fake ( ... ) argument lists
  * to handle functions and concatenation.
- * They assume that whoever calls them will be setting up a fake
- * join call, because each subthing puts a ',' after it.  This lets
- *   "lower \luPpEr"
- * become
- *  join($, , 'lower ', lcfirst( 'uPpEr', ) ,)
- *
- * (I'm not sure whether the spurious commas at the end of lcfirst's
- * arguments and join's arguments are created or not).
+ * For example,
+ *   "foo\lbar"
+ * is tokenised as
+ *    stringify ( const[foo] concat lcfirst ( const[bar] ) )
  */
 
 /*
  */
 
 /*
@@ -2428,6 +2449,7 @@ S_sublex_push(pTHX)
     SAVEI32(PL_lex_casemods);
     SAVEI32(PL_lex_starts);
     SAVEI8(PL_lex_state);
     SAVEI32(PL_lex_casemods);
     SAVEI32(PL_lex_starts);
     SAVEI8(PL_lex_state);
+    SAVEPPTR(PL_sublex_info.re_eval_start);
     SAVEVPTR(PL_lex_inpat);
     SAVEI16(PL_lex_inwhat);
     SAVECOPLINE(PL_curcop);
     SAVEVPTR(PL_lex_inpat);
     SAVEI16(PL_lex_inwhat);
     SAVECOPLINE(PL_curcop);
@@ -2444,6 +2466,7 @@ S_sublex_push(pTHX)
 
     PL_linestr = PL_lex_stuff;
     PL_lex_stuff = NULL;
 
     PL_linestr = PL_lex_stuff;
     PL_lex_stuff = NULL;
+    PL_sublex_info.re_eval_start = NULL;
 
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
        = SvPVX(PL_linestr);
 
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
        = SvPVX(PL_linestr);
@@ -2553,8 +2576,11 @@ S_sublex_done(pTHX)
 /*
   scan_const
 
 /*
   scan_const
 
-  Extracts a pattern, double-quoted string, or transliteration.  This
-  is terrifying code.
+  Extracts the next constant part of a pattern, double-quoted string,
+  or transliteration.  This is terrifying code.
+
+  For example, in parsing the double-quoted string "ab\x63$d", it would
+  stop at the '$' and return an OP_CONST containing 'abc'.
 
   It looks at PL_lex_inwhat and PL_lex_inpat to find out whether it's
   processing a pattern (PL_lex_inpat is true), a transliteration
 
   It looks at PL_lex_inwhat and PL_lex_inpat to find out whether it's
   processing a pattern (PL_lex_inpat is true), a transliteration
@@ -2562,15 +2588,22 @@ S_sublex_done(pTHX)
 
   Returns a pointer to the character scanned up to. If this is
   advanced from the start pointer supplied (i.e. if anything was
 
   Returns a pointer to the character scanned up to. If this is
   advanced from the start pointer supplied (i.e. if anything was
-  successfully parsed), will leave an OP for the substring scanned
+  successfully parsed), will leave an OP_CONST for the substring scanned
   in pl_yylval. Caller must intuit reason for not parsing further
   by looking at the next characters herself.
 
   In patterns:
   in pl_yylval. Caller must intuit reason for not parsing further
   by looking at the next characters herself.
 
   In patterns:
-    backslashes:
-      constants: \N{NAME} only
-      case and quoting: \U \Q \E
-    stops on @ and $, but not for $ as tail anchor
+    expand:
+      \N{ABC}  => \N{U+41.42.43}
+
+    pass through:
+       all other \-char, including \N and \N{ apart from \N{ABC}
+
+    stops on:
+       @ and $ where it appears to be a var, but not for $ as tail anchor
+        \l \L \u \U \Q \E
+       (?{  or  (??{
+
 
   In transliterations:
     characters are VERY literal, except for - not at the start or end
 
   In transliterations:
     characters are VERY literal, except for - not at the start or end
@@ -2600,7 +2633,7 @@ S_sublex_done(pTHX)
   it's a tail anchor if $ is the last thing in the string, or if it's
   followed by one of "()| \r\n\t"
 
   it's a tail anchor if $ is the last thing in the string, or if it's
   followed by one of "()| \r\n\t"
 
-  \1 (backreferences) are turned into $1
+  \1 (backreferences) are turned into $1 in substitutions
 
   The structure of the code is
       while (there's a character to process) {
 
   The structure of the code is
       while (there's a character to process) {
@@ -2828,33 +2861,20 @@ S_scan_const(pTHX_ char *start)
 
        /* if we get here, we're not doing a transliteration */
 
 
        /* if we get here, we're not doing a transliteration */
 
-       /* skip for regexp comments /(?#comment)/ and code /(?{code})/,
-          except for the last char, which will be done separately. */
+       /* skip for regexp comments /(?#comment)/, except for the last
+        * char, which will be done separately.
+        * Stop on (?{..}) and friends */
+
        else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
            if (s[2] == '#') {
                while (s+1 < send && *s != ')')
                    *d++ = NATIVE_TO_NEED(has_utf8,*s++);
            }
        else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
            if (s[2] == '#') {
                while (s+1 < send && *s != ')')
                    *d++ = NATIVE_TO_NEED(has_utf8,*s++);
            }
-           else if (s[2] == '{' /* This should match regcomp.c */
-                   || (s[2] == '?' && s[3] == '{'))
+           else if (!PL_lex_casemods &&
+                    (    s[2] == '{' /* This should match regcomp.c */
+                     || (s[2] == '?' && s[3] == '{')))
            {
            {
-               I32 count = 1;
-               char *regparse = s + (s[2] == '{' ? 3 : 4);
-               char c;
-
-               while (count && (c = *regparse)) {
-                   if (c == '\\' && regparse[1])
-                       regparse++;
-                   else if (c == '{')
-                       count++;
-                   else if (c == '}')
-                       count--;
-                   regparse++;
-               }
-               if (*regparse != ')')
-                   regparse--;         /* Leave one char for continuation. */
-               while (s < regparse)
-                   *d++ = NATIVE_TO_NEED(has_utf8,*s++);
+               break;
            }
        }
 
            }
        }
 
@@ -2865,6 +2885,10 @@ S_scan_const(pTHX_ char *start)
                *d++ = NATIVE_TO_NEED(has_utf8,*s++);
        }
 
                *d++ = NATIVE_TO_NEED(has_utf8,*s++);
        }
 
+       /* no further processing of single-quoted regex */
+       else if (PL_lex_inpat && SvIVX(PL_linestr) == '\'')
+           goto default_action;
+
        /* check for embedded arrays
           (@foo, @::foo, @'foo, @{foo}, @$foo, @+, @-)
           */
        /* check for embedded arrays
           (@foo, @::foo, @'foo, @{foo}, @$foo, @+, @-)
           */
@@ -2911,7 +2935,7 @@ S_scan_const(pTHX_ char *start)
            }
 
            /* string-change backslash escapes */
            }
 
            /* string-change backslash escapes */
-           if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
+           if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQF", *s)) {
                --s;
                break;
            }
                --s;
                break;
            }
@@ -3498,7 +3522,8 @@ S_scan_const(pTHX_ char *start)
     *d = '\0';
     SvCUR_set(sv, d - SvPVX_const(sv));
     if (SvCUR(sv) >= SvLEN(sv))
     *d = '\0';
     SvCUR_set(sv, d - SvPVX_const(sv));
     if (SvCUR(sv) >= SvLEN(sv))
-       Perl_croak(aTHX_ "panic: constant overflowed allocated space");
+       Perl_croak(aTHX_ "panic: constant overflowed allocated space, %"UVuf
+                  " >= %"UVuf, (UV)SvCUR(sv), (UV)SvLEN(sv));
 
     SvPOK_on(sv);
     if (PL_encoding && !has_utf8) {
 
     SvPOK_on(sv);
     if (PL_encoding && !has_utf8) {
@@ -3533,6 +3558,9 @@ S_scan_const(pTHX_ char *start)
            } else if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat) {
                type = "s";
                typelen = 1;
            } else if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat) {
                type = "s";
                typelen = 1;
+           } else if (PL_lex_inpat && SvIVX(PL_linestr) == '\'') {
+               type = "q";
+               typelen = 1;
            } else  {
                type = "qq";
                typelen = 2;
            } else  {
                type = "qq";
                typelen = 2;
@@ -3739,7 +3767,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
            return 0;
        if (cv) {
            if (SvPOK(cv)) {
            return 0;
        if (cv) {
            if (SvPOK(cv)) {
-               const char *proto = SvPVX_const(cv);
+               const char *proto = CvPROTO(cv);
                if (proto) {
                    if (*proto == ';')
                        proto++;
                if (proto) {
                    if (*proto == ';')
                        proto++;
@@ -3838,6 +3866,9 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     if (!PL_parser)
        return NULL;
 
     if (!PL_parser)
        return NULL;
 
+    if (PL_parser->lex_flags & LEX_IGNORE_UTF8_HINTS)
+       Perl_croak(aTHX_ "Source filters apply only to byte streams");
+
     if (!PL_rsfp_filters)
        PL_rsfp_filters = newAV();
     if (!datasv)
     if (!PL_rsfp_filters)
        PL_rsfp_filters = newAV();
     if (!datasv)
@@ -3850,6 +3881,45 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
                          SvPV_nolen(datasv)));
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
                          SvPV_nolen(datasv)));
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
+    if (
+       !PL_parser->filtered
+     && PL_parser->lex_flags & LEX_EVALBYTES
+     && PL_bufptr < PL_bufend
+    ) {
+       const char *s = PL_bufptr;
+       while (s < PL_bufend) {
+           if (*s == '\n') {
+               SV *linestr = PL_parser->linestr;
+               char *buf = SvPVX(linestr);
+               STRLEN const bufptr_pos = PL_parser->bufptr - buf;
+               STRLEN const oldbufptr_pos = PL_parser->oldbufptr - buf;
+               STRLEN const oldoldbufptr_pos=PL_parser->oldoldbufptr-buf;
+               STRLEN const linestart_pos = PL_parser->linestart - buf;
+               STRLEN const last_uni_pos =
+                   PL_parser->last_uni ? PL_parser->last_uni - buf : 0;
+               STRLEN const last_lop_pos =
+                   PL_parser->last_lop ? PL_parser->last_lop - buf : 0;
+               av_push(PL_rsfp_filters, linestr);
+               PL_parser->linestr = 
+                   newSVpvn(SvPVX(linestr), ++s-SvPVX(linestr));
+               buf = SvPVX(PL_parser->linestr);
+               PL_parser->bufend = buf + SvCUR(PL_parser->linestr);
+               PL_parser->bufptr = buf + bufptr_pos;
+               PL_parser->oldbufptr = buf + oldbufptr_pos;
+               PL_parser->oldoldbufptr = buf + oldoldbufptr_pos;
+               PL_parser->linestart = buf + linestart_pos;
+               if (PL_parser->last_uni)
+                   PL_parser->last_uni = buf + last_uni_pos;
+               if (PL_parser->last_lop)
+                   PL_parser->last_lop = buf + last_lop_pos;
+               SvLEN(linestr) = SvCUR(linestr);
+               SvCUR(linestr) = s-SvPVX(linestr);
+               PL_parser->filtered = 1;
+               break;
+           }
+           s++;
+       }
+    }
     return(datasv);
 }
 
     return(datasv);
 }
 
@@ -3892,7 +3962,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
     /* This API is bad. It should have been using unsigned int for maxlen.
        Not sure if we want to change the API, but if not we should sanity
        check the value here.  */
     /* This API is bad. It should have been using unsigned int for maxlen.
        Not sure if we want to change the API, but if not we should sanity
        check the value here.  */
-    const unsigned int correct_length
+    unsigned int correct_length
        = maxlen < 0 ?
 #ifdef PERL_MICRO
        0x7FFFFFFF
        = maxlen < 0 ?
 #ifdef PERL_MICRO
        0x7FFFFFFF
@@ -3944,6 +4014,31 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
                              idx));
        return FILTER_READ(idx+1, buf_sv, correct_length); /* recurse */
     }
                              idx));
        return FILTER_READ(idx+1, buf_sv, correct_length); /* recurse */
     }
+    if (SvTYPE(datasv) != SVt_PVIO) {
+       if (correct_length) {
+           /* Want a block */
+           const STRLEN remainder = SvLEN(datasv) - SvCUR(datasv);
+           if (!remainder) return 0; /* eof */
+           if (correct_length > remainder) correct_length = remainder;
+           sv_catpvn(buf_sv, SvEND(datasv), correct_length);
+           SvCUR_set(datasv, SvCUR(datasv) + correct_length);
+       } else {
+           /* Want a line */
+           const char *s = SvEND(datasv);
+           const char *send = SvPVX(datasv) + SvLEN(datasv);
+           while (s < send) {
+               if (*s == '\n') {
+                   s++;
+                   break;
+               }
+               s++;
+           }
+           if (s == send) return 0; /* eof */
+           sv_catpvn(buf_sv, SvEND(datasv), s-SvEND(datasv));
+           SvCUR_set(datasv, s-SvPVX(datasv));
+       }
+       return SvCUR(buf_sv);
+    }
     /* Get function pointer hidden within datasv       */
     funcp = DPTR2FPTR(filter_t, IoANY(datasv));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
     /* Get function pointer hidden within datasv       */
     funcp = DPTR2FPTR(filter_t, IoANY(datasv));
     DEBUG_P(PerlIO_printf(Perl_debug_log,
@@ -4096,7 +4191,7 @@ Perl_madlex(pTHX)
        }
 
        /* put off final whitespace till peg */
        }
 
        /* put off final whitespace till peg */
-       if (optype == ';' && !PL_rsfp) {
+       if (optype == ';' && !PL_rsfp && !PL_parser->filtered) {
            PL_nextwhite = PL_thiswhite;
            PL_thiswhite = 0;
        }
            PL_nextwhite = PL_thiswhite;
            PL_thiswhite = 0;
        }
@@ -4141,6 +4236,7 @@ Perl_madlex(pTHX)
     case FUNC0SUB:
     case UNIOPSUB:
     case LSTOPSUB:
     case FUNC0SUB:
     case UNIOPSUB:
     case LSTOPSUB:
+    case LABEL:
        if (pl_yylval.opval)
            append_madprops(PL_thismad, pl_yylval.opval, 0);
        PL_thismad = 0;
        if (pl_yylval.opval)
            append_madprops(PL_thismad, pl_yylval.opval, 0);
        PL_thismad = 0;
@@ -4201,10 +4297,6 @@ Perl_madlex(pTHX)
        }
        break;
 
        }
        break;
 
-    /* pval */
-    case LABEL:
-       break;
-
     /* ival */
     default:
        break;
     /* ival */
     default:
        break;
@@ -4398,7 +4490,9 @@ Perl_yylex(pTHX)
     case LEX_INTERPCASEMOD:
 #ifdef DEBUGGING
        if (PL_bufptr != PL_bufend && *PL_bufptr != '\\')
     case LEX_INTERPCASEMOD:
 #ifdef DEBUGGING
        if (PL_bufptr != PL_bufend && *PL_bufptr != '\\')
-           Perl_croak(aTHX_ "panic: INTERPCASEMOD");
+           Perl_croak(aTHX_
+                      "panic: INTERPCASEMOD bufptr=%p, bufend=%p, *bufptr=%u",
+                      PL_bufptr, PL_bufend, *PL_bufptr);
 #endif
        /* handle \E or end of string */
                if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
 #endif
        /* handle \E or end of string */
                if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') {
@@ -4408,7 +4502,8 @@ Perl_yylex(pTHX)
                PL_lex_casestack[PL_lex_casemods] = '\0';
 
                if (PL_bufptr != PL_bufend
                PL_lex_casestack[PL_lex_casemods] = '\0';
 
                if (PL_bufptr != PL_bufend
-                   && (oldmod == 'L' || oldmod == 'U' || oldmod == 'Q')) {
+                   && (oldmod == 'L' || oldmod == 'U' || oldmod == 'Q'
+                        || oldmod == 'F')) {
                    PL_bufptr += 2;
                    PL_lex_state = LEX_INTERPCONCAT;
 #ifdef PERL_MAD
                    PL_bufptr += 2;
                    PL_lex_state = LEX_INTERPCONCAT;
 #ifdef PERL_MAD
@@ -4419,6 +4514,11 @@ Perl_yylex(pTHX)
                PL_lex_allbrackets--;
                return REPORT(')');
            }
                PL_lex_allbrackets--;
                return REPORT(')');
            }
+            else if ( PL_bufptr != PL_bufend && PL_bufptr[1] == 'E' ) {
+               /* Got an unpaired \E */
+               Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                        "Useless use of \\E");
+            }
 #ifdef PERL_MAD
            while (PL_bufptr != PL_bufend &&
              PL_bufptr[0] == '\\' && PL_bufptr[1] == 'E') {
 #ifdef PERL_MAD
            while (PL_bufptr != PL_bufend &&
              PL_bufptr[0] == '\\' && PL_bufptr[1] == 'E') {
@@ -4453,8 +4553,10 @@ Perl_yylex(pTHX)
                if (!PL_madskills) /* when just compiling don't need correct */
                    if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
                        tmp = *s, *s = s[2], s[2] = (char)tmp;  /* misordered... */
                if (!PL_madskills) /* when just compiling don't need correct */
                    if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
                        tmp = *s, *s = s[2], s[2] = (char)tmp;  /* misordered... */
-               if ((*s == 'L' || *s == 'U') &&
-                   (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U'))) {
+               if ((*s == 'L' || *s == 'U' || *s == 'F') &&
+                   (strchr(PL_lex_casestack, 'L')
+                        || strchr(PL_lex_casestack, 'U')
+                        || strchr(PL_lex_casestack, 'F'))) {
                    PL_lex_casestack[--PL_lex_casemods] = '\0';
                    PL_lex_allbrackets--;
                    return REPORT(')');
                    PL_lex_casestack[--PL_lex_casemods] = '\0';
                    PL_lex_allbrackets--;
                    return REPORT(')');
@@ -4478,8 +4580,10 @@ Perl_yylex(pTHX)
                    NEXTVAL_NEXTTOKE.ival = OP_UC;
                else if (*s == 'Q')
                    NEXTVAL_NEXTTOKE.ival = OP_QUOTEMETA;
                    NEXTVAL_NEXTTOKE.ival = OP_UC;
                else if (*s == 'Q')
                    NEXTVAL_NEXTTOKE.ival = OP_QUOTEMETA;
+                else if (*s == 'F')
+                   NEXTVAL_NEXTTOKE.ival = OP_FC;
                else
                else
-                   Perl_croak(aTHX_ "panic: yylex");
+                   Perl_croak(aTHX_ "panic: yylex, *s=%u", *s);
                if (PL_madskills) {
                    SV* const tmpsv = newSVpvs("\\ ");
                    /* replace the space with the character we want to escape
                if (PL_madskills) {
                    SV* const tmpsv = newSVpvs("\\ ");
                    /* replace the space with the character we want to escape
@@ -4516,7 +4620,7 @@ Perl_yylex(pTHX)
     case LEX_INTERPSTART:
        if (PL_bufptr == PL_bufend)
            return REPORT(sublex_done());
     case LEX_INTERPSTART:
        if (PL_bufptr == PL_bufend)
            return REPORT(sublex_done());
-       DEBUG_T({ PerlIO_printf(Perl_debug_log,
+       DEBUG_T({ if(*PL_bufptr != '(') PerlIO_printf(Perl_debug_log,
               "### Interpolated variable\n"); });
        PL_expect = XTERM;
        PL_lex_dojoin = (*PL_bufptr == '@');
               "### Interpolated variable\n"); });
        PL_expect = XTERM;
        PL_lex_dojoin = (*PL_bufptr == '@');
@@ -4537,6 +4641,16 @@ Perl_yylex(pTHX)
            NEXTVAL_NEXTTOKE.ival = OP_JOIN;    /* emulate join($", ...) */
            force_next(FUNC);
        }
            NEXTVAL_NEXTTOKE.ival = OP_JOIN;    /* emulate join($", ...) */
            force_next(FUNC);
        }
+       /* Convert (?{...}) and friends to 'do {...}' */
+       if (PL_lex_inpat && *PL_bufptr == '(') {
+           PL_sublex_info.re_eval_start = PL_bufptr;
+           PL_bufptr += 2;
+           if (*PL_bufptr != '{')
+               PL_bufptr++;
+           PL_expect = XTERMBLOCK;
+           force_next(DO);
+       }
+
        if (PL_lex_starts++) {
            s = PL_bufptr;
 #ifdef PERL_MAD
        if (PL_lex_starts++) {
            s = PL_bufptr;
 #ifdef PERL_MAD
@@ -4582,21 +4696,36 @@ Perl_yylex(pTHX)
                Perl_croak(aTHX_ "Bad evalled substitution pattern");
            PL_lex_repl = NULL;
        }
                Perl_croak(aTHX_ "Bad evalled substitution pattern");
            PL_lex_repl = NULL;
        }
+       if (PL_sublex_info.re_eval_start) {
+           if (*PL_bufptr != ')')
+               Perl_croak(aTHX_ "Sequence (?{...}) not terminated with ')'");
+           PL_bufptr++;
+           /* having compiled a (?{..}) expression, return the original
+            * text too, as a const */
+           PL_nextval[PL_nexttoke].opval =
+                   (OP*)newSVOP(OP_CONST, 0,
+                       newSVpvn(PL_sublex_info.re_eval_start,
+                               PL_bufptr - PL_sublex_info.re_eval_start));
+           force_next(THING);
+           PL_sublex_info.re_eval_start = NULL;
+           PL_expect = XTERM;
+           return REPORT(',');
+       }
+
        /* FALLTHROUGH */
     case LEX_INTERPCONCAT:
 #ifdef DEBUGGING
        if (PL_lex_brackets)
        /* FALLTHROUGH */
     case LEX_INTERPCONCAT:
 #ifdef DEBUGGING
        if (PL_lex_brackets)
-           Perl_croak(aTHX_ "panic: INTERPCONCAT");
+           Perl_croak(aTHX_ "panic: INTERPCONCAT, lex_brackets=%ld",
+                      (long) PL_lex_brackets);
 #endif
        if (PL_bufptr == PL_bufend)
            return REPORT(sublex_done());
 
 #endif
        if (PL_bufptr == PL_bufend)
            return REPORT(sublex_done());
 
-       if (SvIVX(PL_linestr) == '\'') {
+       /* m'foo' still needs to be parsed for possible (?{...}) */
+       if (SvIVX(PL_linestr) == '\'' && !PL_lex_inpat) {
            SV *sv = newSVsv(PL_linestr);
            SV *sv = newSVsv(PL_linestr);
-           if (!PL_lex_inpat)
-               sv = tokeq(sv);
-           else if ( PL_hints & HINT_NEW_RE )
-               sv = new_constant(NULL, 0, "qr", sv, sv, "q", 1);
+           sv = tokeq(sv);
            pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
            s = PL_bufend;
        }
            pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
            s = PL_bufend;
        }
@@ -4662,7 +4791,12 @@ Perl_yylex(pTHX)
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
        {
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
        {
-        unsigned char c = *s;
+        SV *dsv = newSVpvs_flags("", SVs_TEMP);
+        const char *c = UTF ? savepv(sv_uni_display(dsv, newSVpvn_flags(s,
+                                                    UTF8SKIP(s),
+                                                    SVs_TEMP | SVf_UTF8),
+                                            10, UNI_DISPLAY_ISPRINT))
+                            : Perl_form(aTHX_ "\\x%02X", (unsigned char)*s);
         len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
         if (len > UNRECOGNIZED_PRECEDE_COUNT) {
             d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
         len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
         if (len > UNRECOGNIZED_PRECEDE_COUNT) {
             d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
@@ -4670,7 +4804,10 @@ Perl_yylex(pTHX)
             d = PL_linestart;
         }      
         *s = '\0';
             d = PL_linestart;
         }      
         *s = '\0';
-        Perl_croak(aTHX_ "Unrecognized character \\x%02X; marked by <-- HERE after %s<-- HERE near column %d", c, d, (int) len + 1);
+        sv_setpv(dsv, d);
+        if (UTF)
+            SvUTF8_on(dsv);
+        Perl_croak(aTHX_  "Unrecognized character %s; marked by <-- HERE after %"SVf"<-- HERE near column %d", c, SVfARG(dsv), (int) len + 1);
     }
     case 4:
     case 26:
     }
     case 4:
     case 26:
@@ -4680,7 +4817,7 @@ Perl_yylex(pTHX)
        if (PL_madskills)
            PL_faketokens = 0;
 #endif
        if (PL_madskills)
            PL_faketokens = 0;
 #endif
-       if (!PL_rsfp) {
+       if (!PL_rsfp && (!PL_parser->filtered || s+1 < PL_bufend)) {
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets &&
            PL_last_uni = 0;
            PL_last_lop = 0;
            if (PL_lex_brackets &&
@@ -4827,7 +4964,7 @@ Perl_yylex(pTHX)
                    PL_parser->in_pod = 0;
                }
            }
                    PL_parser->in_pod = 0;
                }
            }
-           if (PL_rsfp)
+           if (PL_rsfp || PL_parser->filtered)
                incline(s);
        } while (PL_parser->in_pod);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
                incline(s);
        } while (PL_parser->in_pod);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
@@ -5053,15 +5190,17 @@ Perl_yylex(pTHX)
        if (PL_madskills)
            PL_faketokens = 0;
 #endif
        if (PL_madskills)
            PL_faketokens = 0;
 #endif
-       if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
-           if (*s == '#' && s == PL_linestart && PL_in_eval && !PL_rsfp) {
+       if (PL_lex_state != LEX_NORMAL ||
+            (PL_in_eval && !PL_rsfp && !PL_parser->filtered)) {
+           if (*s == '#' && s == PL_linestart && PL_in_eval
+            && !PL_rsfp && !PL_parser->filtered) {
                /* handle eval qq[#line 1 "foo"\n ...] */
                CopLINE_dec(PL_curcop);
                incline(s);
            }
            if (PL_madskills && !PL_lex_formbrack && !PL_in_eval) {
                s = SKIPSPACE0(s);
                /* handle eval qq[#line 1 "foo"\n ...] */
                CopLINE_dec(PL_curcop);
                incline(s);
            }
            if (PL_madskills && !PL_lex_formbrack && !PL_in_eval) {
                s = SKIPSPACE0(s);
-               if (!PL_in_eval || PL_rsfp)
+               if (!PL_in_eval || PL_rsfp || PL_parser->filtered)
                    incline(s);
            }
            else {
                    incline(s);
            }
            else {
@@ -5071,7 +5210,8 @@ Perl_yylex(pTHX)
                if (d < PL_bufend)
                    d++;
                else if (d > PL_bufend) /* Found by Ilya: feed random input to Perl. */
                if (d < PL_bufend)
                    d++;
                else if (d > PL_bufend) /* Found by Ilya: feed random input to Perl. */
-                 Perl_croak(aTHX_ "panic: input overflow");
+                   Perl_croak(aTHX_ "panic: input overflow, %p > %p",
+                              d, PL_bufend);
 #ifdef PERL_MAD
                if (PL_madskills)
                    PL_thiswhite = newSVpvn(s, d - s);
 #ifdef PERL_MAD
                if (PL_madskills)
                    PL_thiswhite = newSVpvn(s, d - s);
@@ -5382,7 +5522,7 @@ Perl_yylex(pTHX)
                        break;
                    }
                }
                        break;
                    }
                }
-               sv = newSVpvn(s, len);
+               sv = newSVpvn_flags(s, len, UTF ? SVf_UTF8 : 0);
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
                if (*d == '(') {
                    d = scan_str(d,TRUE,TRUE);
                    if (!d) {
@@ -5838,7 +5978,7 @@ Perl_yylex(pTHX)
            if (PL_expect == XSTATE && isALPHA(tmp) &&
                (s == PL_linestart+1 || s[-2] == '\n') )
                {
            if (PL_expect == XSTATE && isALPHA(tmp) &&
                (s == PL_linestart+1 || s[-2] == '\n') )
                {
-                   if (PL_in_eval && !PL_rsfp) {
+                   if (PL_in_eval && !PL_rsfp && !PL_parser->filtered) {
                        d = PL_bufend;
                        while (s < d) {
                            if (*s++ == '\n') {
                        d = PL_bufend;
                        while (s < d) {
                            if (*s++ == '\n') {
@@ -6070,10 +6210,12 @@ Perl_yylex(pTHX)
                                              &len);
                                while (isSPACE(*t))
                                    t++;
                                              &len);
                                while (isSPACE(*t))
                                    t++;
-                               if (*t == ';' && get_cvn_flags(tmpbuf, len, 0))
+                               if (*t == ';'
+                                       && get_cvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0))
                                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                    Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                               "You need to quote \"%s\"",
-                                               tmpbuf);
+                                               "You need to quote \"%"SVf"\"",
+                                                 SVfARG(newSVpvn_flags(tmpbuf, len, 
+                                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
                            }
                        }
                }
                            }
                        }
                }
@@ -6152,14 +6294,17 @@ Perl_yylex(pTHX)
                if (ckWARN(WARN_SYNTAX)) {
                    const char *t = s + 1;
                    while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
                if (ckWARN(WARN_SYNTAX)) {
                    const char *t = s + 1;
                    while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
-                       t++;
+                       t += UTF ? UTF8SKIP(t) : 1;
                    if (*t == '}' || *t == ']') {
                        t++;
                        PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
                    if (*t == '}' || *t == ']') {
                        t++;
                        PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
+       /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                           "Scalar value %.*s better written as $%.*s",
-                           (int)(t-PL_bufptr), PL_bufptr,
-                           (int)(t-PL_bufptr-1), PL_bufptr+1);
+                           "Scalar value %"SVf" better written as $%"SVf,
+                           SVfARG(newSVpvn_flags(PL_bufptr, (STRLEN)(t-PL_bufptr),
+                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0 ))),
+                            SVfARG(newSVpvn_flags(PL_bufptr+1, (STRLEN)(t-PL_bufptr-1),
+                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0 ))));
                    }
                }
            }
                    }
                }
            }
@@ -6454,7 +6599,9 @@ Perl_yylex(pTHX)
        if (!anydelim && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
            s = d + 1;
        if (!anydelim && PL_expect == XSTATE
              && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
            s = d + 1;
-           pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
+           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+                                            newSVpvn_flags(PL_tokenbuf,
+                                                        len, UTF ? SVf_UTF8 : 0));
            CLINE;
            TOKEN(LABEL);
        }
            CLINE;
            TOKEN(LABEL);
        }
@@ -6475,7 +6622,7 @@ Perl_yylex(pTHX)
                }
                if (!ogv &&
                    (gvp = (GV**)hv_fetch(PL_globalstash, PL_tokenbuf,
                }
                if (!ogv &&
                    (gvp = (GV**)hv_fetch(PL_globalstash, PL_tokenbuf,
-                                            UTF ? -len : len, FALSE)) &&
+                                            UTF ? -(I32)len : (I32)len, FALSE)) &&
                    (gv = *gvp) && isGV_with_GP(gv) &&
                    GvCVu(gv) && GvIMPORTED_CV(gv))
                {
                    (gv = *gvp) && isGV_with_GP(gv) &&
                    GvCVu(gv) && GvIMPORTED_CV(gv))
                {
@@ -6540,7 +6687,9 @@ Perl_yylex(pTHX)
                    s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
                                  TRUE, &morelen);
                    if (!morelen)
                    s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len,
                                  TRUE, &morelen);
                    if (!morelen)
-                       Perl_croak(aTHX_ "Bad name after %s%s", PL_tokenbuf,
+                       Perl_croak(aTHX_ "Bad name after %"SVf"%s",
+                                        SVfARG(newSVpvn_flags(PL_tokenbuf, len,
+                                            (UTF ? SVf_UTF8 : 0) | SVs_TEMP )),
                                *s == '\'' ? "'" : "::");
                    len += morelen;
                    pkgname = 1;
                                *s == '\'' ? "'" : "::");
                    len += morelen;
                    pkgname = 1;
@@ -6566,8 +6715,9 @@ Perl_yylex(pTHX)
                    if (ckWARN(WARN_BAREWORD)
                        && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
                        Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
                    if (ckWARN(WARN_BAREWORD)
                        && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV))
                        Perl_warner(aTHX_ packWARN(WARN_BAREWORD),
-                           "Bareword \"%s\" refers to nonexistent package",
-                            PL_tokenbuf);
+                           "Bareword \"%"SVf"\" refers to nonexistent package",
+                            SVfARG(newSVpvn_flags(PL_tokenbuf, len,
+                                        (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));
                    len -= 2;
                    PL_tokenbuf[len] = '\0';
                    gv = NULL;
                    len -= 2;
                    PL_tokenbuf[len] = '\0';
                    gv = NULL;
@@ -6748,10 +6898,12 @@ Perl_yylex(pTHX)
                /* Not a method, so call it a subroutine (if defined) */
 
                if (cv) {
                /* Not a method, so call it a subroutine (if defined) */
 
                if (cv) {
-                   if (lastchar == '-')
-                       Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-                                        "Ambiguous use of -%s resolved as -&%s()",
-                                        PL_tokenbuf, PL_tokenbuf);
+                   if (lastchar == '-') {
+                        const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP );
+                       Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
+                               "Ambiguous use of -%"SVf" resolved as -&%"SVf"()",
+                               SVfARG(tmpsv), SVfARG(tmpsv));
+                    }
                    /* Check for a constant sub */
                    if ((sv = cv_const_sv(cv))) {
                  its_constant:
                    /* Check for a constant sub */
                    if ((sv = cv_const_sv(cv))) {
                  its_constant:
@@ -6775,12 +6927,15 @@ Perl_yylex(pTHX)
 #endif
                        SvPOK(cv))
                    {
 #endif
                        SvPOK(cv))
                    {
-                       STRLEN protolen;
-                       const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
+                       STRLEN protolen = CvPROTOLEN(cv);
+                       const char *proto = CvPROTO(cv);
+                       bool optional;
                        if (!protolen)
                            TERM(FUNC0SUB);
                        if (!protolen)
                            TERM(FUNC0SUB);
-                       while (*proto == ';')
+                       if ((optional = *proto == ';'))
+                         do
                            proto++;
                            proto++;
+                         while (*proto == ';');
                        if (
                            (
                                (
                        if (
                            (
                                (
@@ -6793,12 +6948,13 @@ Perl_yylex(pTHX)
                             *proto == '\\' && proto[1] && proto[2] == '\0'
                            )
                        )
                             *proto == '\\' && proto[1] && proto[2] == '\0'
                            )
                        )
-                           OPERATOR(UNIOPSUB);
+                           UNIPROTO(UNIOPSUB,optional);
                        if (*proto == '\\' && proto[1] == '[') {
                            const char *p = proto + 2;
                            while(*p && *p != ']')
                                ++p;
                        if (*proto == '\\' && proto[1] == '[') {
                            const char *p = proto + 2;
                            while(*p && *p != ']')
                                ++p;
-                           if(*p == ']' && !p[1]) OPERATOR(UNIOPSUB);
+                           if(*p == ']' && !p[1])
+                               UNIPROTO(UNIOPSUB,optional);
                        }
                        if (*proto == '&' && *s == '{') {
                            if (PL_curstash)
                        }
                        if (*proto == '&' && *s == '{') {
                            if (PL_curstash)
@@ -6919,8 +7075,10 @@ Perl_yylex(pTHX)
            safe_bareword:
                if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) {
                    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
            safe_bareword:
                if ((lastchar == '*' || lastchar == '%' || lastchar == '&')) {
                    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-                                    "Operator or semicolon missing before %c%s",
-                                    lastchar, PL_tokenbuf);
+                                    "Operator or semicolon missing before %c%"SVf,
+                                    lastchar, SVfARG(newSVpvn_flags(PL_tokenbuf,
+                                                    strlen(PL_tokenbuf),
+                                                    SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
                    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
                                     "Ambiguous use of %c resolved as operator %c",
                                     lastchar, lastchar);
                    Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
                                     "Ambiguous use of %c resolved as operator %c",
                                     lastchar, lastchar);
@@ -6952,10 +7110,20 @@ Perl_yylex(pTHX)
            GV *gv;
            if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
                const char *pname = "main";
            GV *gv;
            if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
                const char *pname = "main";
+               STRLEN plen = 4;
+               U32 putf8 = 0;
                if (PL_tokenbuf[2] == 'D')
                if (PL_tokenbuf[2] == 'D')
-                   pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash);
-               gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), GV_ADD,
-                               SVt_PVIO);
+               {
+                   HV * const stash =
+                       PL_curstash ? PL_curstash : PL_defstash;
+                   pname = HvNAME_get(stash);
+                   plen  = HvNAMELEN (stash);
+                   if(HvNAMEUTF8(stash)) putf8 = SVf_UTF8;
+               }
+               gv = gv_fetchpvn_flags(
+                       Perl_form(aTHX_ "%*s::DATA", (int)plen, pname),
+                       plen+6, GV_ADD|putf8, SVt_PVIO
+               );
                GvMULTI_on(gv);
                if (!GvIO(gv))
                    GvIOp(gv) = newIO();
                GvMULTI_on(gv);
                if (!GvIO(gv))
                    GvIOp(gv) = newIO();
@@ -7039,6 +7207,9 @@ Perl_yylex(pTHX)
            goto fake_eof;
        }
 
            goto fake_eof;
        }
 
+       case KEY___SUB__:
+           FUN0OP(newPVOP(OP_RUNCV,0,NULL));
+
        case KEY_AUTOLOAD:
        case KEY_DESTROY:
        case KEY_BEGIN:
        case KEY_AUTOLOAD:
        case KEY_DESTROY:
        case KEY_BEGIN:
@@ -7058,10 +7229,13 @@ Perl_yylex(pTHX)
                d = s;
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
                if (!(tmp = keyword(PL_tokenbuf, len, 1)))
                d = s;
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
                if (!(tmp = keyword(PL_tokenbuf, len, 1)))
-                   Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
+                   Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword",
+                                    SVfARG(newSVpvn_flags(PL_tokenbuf, len,
+                                                (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));
                if (tmp < 0)
                    tmp = -tmp;
                if (tmp < 0)
                    tmp = -tmp;
-               else if (tmp == KEY_require || tmp == KEY_do)
+               else if (tmp == KEY_require || tmp == KEY_do
+                     || tmp == KEY_glob)
                    /* that's a way to remember we saw "CORE::" */
                    orig_keyword = tmp;
                goto reserved_word;
                    /* that's a way to remember we saw "CORE::" */
                    orig_keyword = tmp;
                goto reserved_word;
@@ -7233,6 +7407,10 @@ Perl_yylex(pTHX)
                UNIBRACK(OP_ENTEREVAL);
            }
 
                UNIBRACK(OP_ENTEREVAL);
            }
 
+       case KEY_evalbytes:
+           PL_expect = XTERM;
+           UNIBRACK(-OP_ENTEREVAL);
+
        case KEY_eof:
            UNI(OP_EOF);
 
        case KEY_eof:
            UNI(OP_EOF);
 
@@ -7301,6 +7479,9 @@ Perl_yylex(pTHX)
        case KEY_fork:
            FUN0(OP_FORK);
 
        case KEY_fork:
            FUN0(OP_FORK);
 
+       case KEY_fc:
+           UNI(OP_FC);
+
        case KEY_fcntl:
            LOP(OP_FCNTL,XTERM);
 
        case KEY_fcntl:
            LOP(OP_FCNTL,XTERM);
 
@@ -7413,7 +7594,10 @@ Perl_yylex(pTHX)
            OPERATOR(GIVEN);
 
        case KEY_glob:
            OPERATOR(GIVEN);
 
        case KEY_glob:
-           LOP(OP_GLOB,XTERM);
+           LOP(
+            orig_keyword==KEY_glob ? (orig_keyword=0, -OP_GLOB) : OP_GLOB,
+            XTERM
+           );
 
        case KEY_hex:
            UNI(OP_HEX);
 
        case KEY_hex:
            UNI(OP_HEX);
@@ -7526,7 +7710,7 @@ Perl_yylex(pTHX)
                    char tmpbuf[1024];
                    PL_bufptr = s;
                    my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
                    char tmpbuf[1024];
                    PL_bufptr = s;
                    my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
-                   yyerror(tmpbuf);
+                   yyerror_pv(tmpbuf, UTF ? SVf_UTF8 : 0);
                }
 #ifdef PERL_MAD
                if (PL_madskills) {     /* just add type to declarator token */
                }
 #ifdef PERL_MAD
                if (PL_madskills) {     /* just add type to declarator token */
@@ -7566,18 +7750,27 @@ Perl_yylex(pTHX)
            s = SKIPSPACE1(s);
            if (isIDFIRST_lazy_if(s,UTF)) {
                const char *t;
            s = SKIPSPACE1(s);
            if (isIDFIRST_lazy_if(s,UTF)) {
                const char *t;
-               for (d = s; isALNUM_lazy_if(d,UTF);)
-                   d++;
+               for (d = s; isALNUM_lazy_if(d,UTF);) {
+                   d += UTF ? UTF8SKIP(d) : 1;
+                    if (UTF) {
+                        while (UTF8_IS_CONTINUED(*d) && is_utf8_mark((U8*)d)) {
+                            d += UTF ? UTF8SKIP(d) : 1;
+                        }
+                    }
+                }
                for (t=d; isSPACE(*t);)
                    t++;
                if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
                    /* [perl #16184] */
                    && !(t[0] == '=' && t[1] == '>')
                for (t=d; isSPACE(*t);)
                    t++;
                if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
                    /* [perl #16184] */
                    && !(t[0] == '=' && t[1] == '>')
+                   && !(t[0] == ':' && t[1] == ':')
+                   && !keyword(s, d-s, 0)
                ) {
                ) {
-                   int parms_len = (int)(d-s);
+                   SV *tmpsv = newSVpvn_flags(s, (STRLEN)(d-s),
+                                                SVs_TEMP | (UTF ? SVf_UTF8 : 0));
                    Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
                    Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
-                          "Precedence problem: open %.*s should be open(%.*s)",
-                           parms_len, s, parms_len, s);
+                          "Precedence problem: open %"SVf" should be open(%"SVf")",
+                           SVfARG(tmpsv), SVfARG(tmpsv));
                }
            }
            LOP(OP_OPEN,XTERM);
                }
            }
            LOP(OP_OPEN,XTERM);
@@ -7887,8 +8080,6 @@ Perl_yylex(pTHX)
        case KEY_sort:
            checkcomma(s,PL_tokenbuf,"subroutine name");
            s = SKIPSPACE1(s);
        case KEY_sort:
            checkcomma(s,PL_tokenbuf,"subroutine name");
            s = SKIPSPACE1(s);
-           if (*s == ';' || *s == ')')         /* probably a close */
-               Perl_croak(aTHX_ "sort is now a reserved word");
            PL_expect = XTERM;
            s = force_word(s,WORD,TRUE,TRUE,FALSE);
            LOP(OP_SORT,XREF);
            PL_expect = XTERM;
            s = force_word(s,WORD,TRUE,TRUE,FALSE);
            LOP(OP_SORT,XREF);
@@ -8014,26 +8205,27 @@ Perl_yylex(pTHX)
                    bool underscore = FALSE;
                    bool seen_underscore = FALSE;
                    const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO);
                    bool underscore = FALSE;
                    bool seen_underscore = FALSE;
                    const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO);
+                    STRLEN tmplen;
 
                    s = scan_str(s,!!PL_madskills,FALSE);
                    if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
                    /* strip spaces and check for bad characters */
 
                    s = scan_str(s,!!PL_madskills,FALSE);
                    if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
                    /* strip spaces and check for bad characters */
-                   d = SvPVX(PL_lex_stuff);
+                   d = SvPV(PL_lex_stuff, tmplen);
                    tmp = 0;
                    tmp = 0;
-                   for (p = d; *p; ++p) {
+                   for (p = d; tmplen; tmplen--, ++p) {
                        if (!isSPACE(*p)) {
                        if (!isSPACE(*p)) {
-                           d[tmp++] = *p;
+                            d[tmp++] = *p;
 
                            if (warnillegalproto) {
                                if (must_be_last)
                                    proto_after_greedy_proto = TRUE;
 
                            if (warnillegalproto) {
                                if (must_be_last)
                                    proto_after_greedy_proto = TRUE;
-                               if (!strchr("$@%*;[]&\\_+", *p)) {
+                               if (!strchr("$@%*;[]&\\_+", *p) || *p == '\0') {
                                    bad_proto = TRUE;
                                }
                                else {
                                    if ( underscore ) {
                                    bad_proto = TRUE;
                                }
                                else {
                                    if ( underscore ) {
-                                       if ( *p != ';' )
+                                       if ( !strchr(";@%", *p) )
                                            bad_proto = TRUE;
                                        underscore = FALSE;
                                    }
                                            bad_proto = TRUE;
                                        underscore = FALSE;
                                    }
@@ -8056,17 +8248,26 @@ Perl_yylex(pTHX)
                            }
                        }
                    }
                            }
                        }
                    }
-                   d[tmp] = '\0';
+                    d[tmp] = '\0';
                    if (proto_after_greedy_proto)
                        Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
                                    "Prototype after '%c' for %"SVf" : %s",
                                    greedy_proto, SVfARG(PL_subname), d);
                    if (proto_after_greedy_proto)
                        Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
                                    "Prototype after '%c' for %"SVf" : %s",
                                    greedy_proto, SVfARG(PL_subname), d);
-                   if (bad_proto)
+                   if (bad_proto) {
+                        SV *dsv = newSVpvs_flags("", SVs_TEMP);
                        Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
                                    "Illegal character %sin prototype for %"SVf" : %s",
                                    seen_underscore ? "after '_' " : "",
                        Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
                                    "Illegal character %sin prototype for %"SVf" : %s",
                                    seen_underscore ? "after '_' " : "",
-                                   SVfARG(PL_subname), d);
-                   SvCUR_set(PL_lex_stuff, tmp);
+                                   SVfARG(PL_subname),
+                                    SvUTF8(PL_lex_stuff)
+                                        ? sv_uni_display(dsv,
+                                            newSVpvn_flags(d, tmp, SVs_TEMP | SVf_UTF8),
+                                            tmp,
+                                            UNI_DISPLAY_ISPRINT)
+                                        : pv_pretty(dsv, d, tmp, 60, NULL, NULL,
+                                            PERL_PV_ESCAPE_NONASCII));
+                    }
+                    SvCUR_set(PL_lex_stuff, tmp);
                    have_proto = TRUE;
 
 #ifdef PERL_MAD
                    have_proto = TRUE;
 
 #ifdef PERL_MAD
@@ -8317,15 +8518,16 @@ S_pending_ident(pTHX)
     if (PL_in_my) {
         if (PL_in_my == KEY_our) {     /* "our" is merely analogous to "my" */
             if (has_colon)
     if (PL_in_my) {
         if (PL_in_my == KEY_our) {     /* "our" is merely analogous to "my" */
             if (has_colon)
-                yyerror(Perl_form(aTHX_ "No package name allowed for "
+                yyerror_pv(Perl_form(aTHX_ "No package name allowed for "
                                   "variable %s in \"our\"",
                                   "variable %s in \"our\"",
-                                  PL_tokenbuf));
+                                  PL_tokenbuf), UTF ? SVf_UTF8 : 0);
             tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
             if (has_colon)
             tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
             if (has_colon)
-                yyerror(Perl_form(aTHX_ PL_no_myglob,
-                           PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
+                yyerror_pv(Perl_form(aTHX_ PL_no_myglob,
+                           PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf),
+                            UTF ? SVf_UTF8 : 0);
 
             pl_yylval.opval = newOP(OP_PADANY, 0);
             pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
 
             pl_yylval.opval = newOP(OP_PADANY, 0);
             pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
@@ -8358,7 +8560,7 @@ S_pending_ident(pTHX)
                HEK * const stashname = HvNAME_HEK(stash);
                SV *  const sym = newSVhek(stashname);
                 sv_catpvs(sym, "::");
                HEK * const stashname = HvNAME_HEK(stash);
                SV *  const sym = newSVhek(stashname);
                 sv_catpvs(sym, "::");
-                sv_catsv(sym, newSVpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1, SVs_TEMP | (UTF ? SVf_UTF8 : 0 )));
+                sv_catpvn_flags(sym, PL_tokenbuf+1, tokenbuf_len - 1, (UTF ? SV_CATUTF8 : SV_CATBYTES ));
                 pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
                 pl_yylval.opval->op_private = OPpCONST_ENTERED;
                 gv_fetchsv(sym,
                 pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
                 pl_yylval.opval->op_private = OPpCONST_ENTERED;
                 gv_fetchsv(sym,
@@ -8412,8 +8614,9 @@ S_pending_ident(pTHX)
         {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
         {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                       "Possible unintended interpolation of %s in string",
-                       PL_tokenbuf);
+                       "Possible unintended interpolation of %"SVf" in string",
+                       SVfARG(newSVpvn_flags(PL_tokenbuf, tokenbuf_len,
+                                        SVs_TEMP | ( UTF ? SVf_UTF8 : 0 ))));
         }
     }
 
         }
     }
 
@@ -8466,9 +8669,10 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
     while (s < PL_bufend && isSPACE(*s))
        s++;
     if (isIDFIRST_lazy_if(s,UTF)) {
     while (s < PL_bufend && isSPACE(*s))
        s++;
     if (isIDFIRST_lazy_if(s,UTF)) {
-       const char * const w = s++;
+       const char * const w = s;
+        s += UTF ? UTF8SKIP(s) : 1;
        while (isALNUM_lazy_if(s,UTF))
        while (isALNUM_lazy_if(s,UTF))
-           s++;
+           s += UTF ? UTF8SKIP(s) : 1;
        while (s < PL_bufend && isSPACE(*s))
            s++;
        if (*s == ',') {
        while (s < PL_bufend && isSPACE(*s))
            s++;
        if (*s == ',') {
@@ -8494,7 +8698,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
               SV *sv, SV *pv, const char *type, STRLEN typelen)
 {
     dVAR; dSP;
               SV *sv, SV *pv, const char *type, STRLEN typelen)
 {
     dVAR; dSP;
-    HV * const table = GvHV(PL_hintgv);                 /* ^H */
+    HV * table = GvHV(PL_hintgv);               /* ^H */
     SV *res;
     SV **cvp;
     SV *cv, *typesv;
     SV *res;
     SV **cvp;
     SV *cv, *typesv;
@@ -8502,43 +8706,57 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
 
     PERL_ARGS_ASSERT_NEW_CONSTANT;
 
 
     PERL_ARGS_ASSERT_NEW_CONSTANT;
 
-    if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
+    /* charnames doesn't work well if there have been errors found */
+    if (PL_error_count > 0 && strEQ(key,"charnames"))
+       return &PL_sv_undef;
+
+    if (!table
+       || ! (PL_hints & HINT_LOCALIZE_HH)
+       || ! (cvp = hv_fetch(table, key, keylen, FALSE))
+       || ! SvOK(*cvp))
+    {
        SV *msg;
        
        SV *msg;
        
-       why2 = (const char *)
-           (strEQ(key,"charnames")
-            ? "(possibly a missing \"use charnames ...\")"
-            : "");
-       msg = Perl_newSVpvf(aTHX_ "Constant(%s) unknown: %s",
-                           (type ? type: "undef"), why2);
-
-       /* This is convoluted and evil ("goto considered harmful")
-        * but I do not understand the intricacies of all the different
-        * failure modes of %^H in here.  The goal here is to make
-        * the most probable error message user-friendly. --jhi */
-
-       goto msgdone;
-
+       /* Here haven't found what we're looking for.  If it is charnames,
+        * perhaps it needs to be loaded.  Try doing that before giving up */
+       if (strEQ(key,"charnames")) {
+           Perl_load_module(aTHX_
+                           0,
+                           newSVpvs("_charnames"),
+                            /* version parameter; no need to specify it, as if
+                             * we get too early a version, will fail anyway,
+                             * not being able to find '_charnames' */
+                           NULL,
+                           newSVpvs(":full"),
+                           newSVpvs(":short"),
+                           NULL);
+           SPAGAIN;
+           table = GvHV(PL_hintgv);
+           if (table
+               && (PL_hints & HINT_LOCALIZE_HH)
+               && (cvp = hv_fetch(table, key, keylen, FALSE))
+               && SvOK(*cvp))
+           {
+               goto now_ok;
+           }
+       }
+       if (!table || !(PL_hints & HINT_LOCALIZE_HH)) {
+           msg = Perl_newSVpvf(aTHX_
+                           "Constant(%s) unknown", (type ? type: "undef"));
+       }
+       else {
+       why1 = "$^H{";
+       why2 = key;
+       why3 = "} is not defined";
     report:
        msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s",
                            (type ? type: "undef"), why1, why2, why3);
     report:
        msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s",
                            (type ? type: "undef"), why1, why2, why3);
-    msgdone:
+       }
        yyerror(SvPVX_const(msg));
        SvREFCNT_dec(msg);
        return sv;
     }
        yyerror(SvPVX_const(msg));
        SvREFCNT_dec(msg);
        return sv;
     }
-
-    /* charnames doesn't work well if there have been errors found */
-    if (PL_error_count > 0 && strEQ(key,"charnames"))
-       return &PL_sv_undef;
-
-    cvp = hv_fetch(table, key, keylen, FALSE);
-    if (!cvp || !SvOK(*cvp)) {
-       why1 = "$^H{";
-       why2 = key;
-       why3 = "} is not defined";
-       goto report;
-    }
+now_ok:
     sv_2mortal(sv);                    /* Parent created it permanently */
     cv = *cvp;
     if (!pv && s)
     sv_2mortal(sv);                    /* Parent created it permanently */
     cv = *cvp;
     if (!pv && s)
@@ -8607,7 +8825,7 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag
     for (;;) {
        if (d >= e)
            Perl_croak(aTHX_ ident_too_long);
     for (;;) {
        if (d >= e)
            Perl_croak(aTHX_ ident_too_long);
-       if (isALNUM(*s))        /* UTF handled below */
+       if (isALNUM(*s) || (!UTF && isALNUMC_L1(*s)))   /* UTF handled below */
            *d++ = *s++;
        else if (allow_package && (*s == '\'') && isIDFIRST_lazy_if(s+1,UTF)) {
            *d++ = ':';
            *d++ = *s++;
        else if (allow_package && (*s == '\'') && isIDFIRST_lazy_if(s+1,UTF)) {
            *d++ = ':';
@@ -8703,15 +8921,25 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
        bracket = s;
        s++;
     }
        bracket = s;
        s++;
     }
-    else if (ck_uni)
-       check_uni();
-    if (s < send)
-       *d = *s++;
-    d[1] = '\0';
+    if (s < send) {
+        if (UTF) {
+            const STRLEN skip = UTF8SKIP(s);
+            STRLEN i;
+            d[skip] = '\0';
+            for ( i = 0; i < skip; i++ )
+                d[i] = *s++;
+        }
+        else {
+            *d = *s++;
+            d[1] = '\0';
+        }
+    }
     if (*d == '^' && *s && isCONTROLVAR(*s)) {
        *d = toCTRL(*s);
        s++;
     }
     if (*d == '^' && *s && isCONTROLVAR(*s)) {
        *d = toCTRL(*s);
        s++;
     }
+    else if (ck_uni && !bracket)
+       check_uni();
     if (bracket) {
        if (isSPACE(s[-1])) {
            while (s < send) {
     if (bracket) {
        if (isSPACE(s[-1])) {
            while (s < send) {
@@ -8723,7 +8951,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
            }
        }
        if (isIDFIRST_lazy_if(d,UTF)) {
            }
        }
        if (isIDFIRST_lazy_if(d,UTF)) {
-           d++;
+           d += UTF8SKIP(d);
            if (UTF) {
                char *end = s;
                while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':') {
            if (UTF) {
                char *end = s;
                while ((end < send && isALNUM_lazy_if(end,UTF)) || *end == ':') {
@@ -8782,13 +9010,15 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
            if (PL_lex_state == LEX_NORMAL) {
                if (ckWARN(WARN_AMBIGUOUS) &&
                    (keyword(dest, d - dest, 0)
            if (PL_lex_state == LEX_NORMAL) {
                if (ckWARN(WARN_AMBIGUOUS) &&
                    (keyword(dest, d - dest, 0)
-                    || get_cvn_flags(dest, d - dest, 0)))
+                    || get_cvn_flags(dest, d - dest, UTF ? SVf_UTF8 : 0)))
                {
                {
+                    SV *tmp = newSVpvn_flags( dest, d - dest,
+                                            SVs_TEMP | (UTF ? SVf_UTF8 : 0) );
                    if (funny == '#')
                        funny = '@';
                    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
                    if (funny == '#')
                        funny = '@';
                    Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                       "Ambiguous use of %c{%s} resolved to %c%s",
-                       funny, dest, funny, dest);
+                       "Ambiguous use of %c{%"SVf"} resolved to %c%"SVf,
+                       funny, tmp, funny, tmp);
                }
            }
        }
                }
            }
        }
@@ -8813,13 +9043,15 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
      * current regex.  This routine will set it to any charset modifier found.
      * The caller shouldn't change it.  This way, another charset modifier
      * encountered in the parse can be detected as an error, as we have decided
      * current regex.  This routine will set it to any charset modifier found.
      * The caller shouldn't change it.  This way, another charset modifier
      * encountered in the parse can be detected as an error, as we have decided
-     * allow only one */
+     * to allow only one */
 
     const char c = **s;
 
     if (! strchr(valid_flags, c)) {
         if (isALNUM(c)) {
 
     const char c = **s;
 
     if (! strchr(valid_flags, c)) {
         if (isALNUM(c)) {
-           goto deprecate;
+           yyerror(Perl_form(aTHX_ "Unknown regexp modifier \"/%c\"", c));
+            (*s)++;
+            return TRUE;
         }
         return FALSE;
     }
         }
         return FALSE;
     }
@@ -8833,34 +9065,6 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
         case KEEPCOPY_PAT_MOD:    *pmfl |= RXf_PMf_KEEPCOPY; break;
         case NONDESTRUCT_PAT_MOD: *pmfl |= PMf_NONDESTRUCT; break;
        case LOCALE_PAT_MOD:
         case KEEPCOPY_PAT_MOD:    *pmfl |= RXf_PMf_KEEPCOPY; break;
         case NONDESTRUCT_PAT_MOD: *pmfl |= PMf_NONDESTRUCT; break;
        case LOCALE_PAT_MOD:
-
-           /* In 5.14, qr//lt is legal but deprecated; the 't' means they
-            * can't be regex modifiers.
-            * In 5.14, s///le is legal and ambiguous.  Try to disambiguate as
-            * much as easily done.  s///lei, for example, has to mean regex
-            * modifiers if it's not an error (as does any word character
-            * following the 'e').  Otherwise, we resolve to the backwards-
-            * compatible, but less likely 's/// le ...', i.e. as meaning
-            * less-than-or-equal.  The reason it's not likely is that s//
-            * returns a number for code in the field (/r returns a string, but
-            * that wasn't added until the 5.13 series), and so '<=' should be
-            * used for comparing, not 'le'. */
-           if (*((*s) + 1) == 't') {
-               goto deprecate;
-           }
-           else if (*((*s) + 1) == 'e' && ! isALNUM(*((*s) + 2))) {
-
-               /* 'e' is valid only for substitutes, s///e.  If it is not
-                * valid in the current context, then 'm//le' must mean the
-                * comparison operator, so use the regular deprecation message.
-                */
-               if (! strchr(valid_flags, 'e')) {
-                   goto deprecate;
-               }
-               Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-                   "Ambiguous use of 's//le...' resolved as 's// le...'; Rewrite as 's//el' if you meant 'use locale rules and evaluate rhs as an expression'.  In Perl 5.16, it will be resolved the other way");
-               return FALSE;
-           }
            if (*charset) {
                goto multiple_charsets;
            }
            if (*charset) {
                goto multiple_charsets;
            }
@@ -8868,11 +9072,6 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
            *charset = c;
            break;
        case UNICODE_PAT_MOD:
            *charset = c;
            break;
        case UNICODE_PAT_MOD:
-           /* In 5.14, qr//unless and qr//until are legal but deprecated; the
-            * 'n' means they can't be regex modifiers */
-           if (*((*s) + 1) == 'n') {
-               goto deprecate;
-           }
            if (*charset) {
                goto multiple_charsets;
            }
            if (*charset) {
                goto multiple_charsets;
            }
@@ -8880,12 +9079,6 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
            *charset = c;
            break;
        case ASCII_RESTRICT_PAT_MOD:
            *charset = c;
            break;
        case ASCII_RESTRICT_PAT_MOD:
-           /* In 5.14, qr//and is legal but deprecated; the 'n' means they
-            * can't be regex modifiers */
-           if (*((*s) + 1) == 'n') {
-               goto deprecate;
-           }
-
            if (! *charset) {
                set_regex_charset(pmfl, REGEX_ASCII_RESTRICTED_CHARSET);
            }
            if (! *charset) {
                set_regex_charset(pmfl, REGEX_ASCII_RESTRICTED_CHARSET);
            }
@@ -8915,11 +9108,6 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse
     (*s)++;
     return TRUE;
 
     (*s)++;
     return TRUE;
 
-    deprecate:
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
-           "Having no space between pattern and following word is deprecated");
-        return FALSE;
-
     multiple_charsets:
        if (*charset != c) {
            yyerror(Perl_form(aTHX_ "Regexp modifiers \"/%c\" and \"/%c\" are mutually exclusive", *charset, c));
     multiple_charsets:
        if (*charset != c) {
            yyerror(Perl_form(aTHX_ "Regexp modifiers \"/%c\" and \"/%c\" are mutually exclusive", *charset, c));
@@ -9118,7 +9306,6 @@ S_scan_trans(pTHX_ char *start)
     dVAR;
     register char* s;
     OP *o;
     dVAR;
     register char* s;
     OP *o;
-    short *tbl;
     U8 squash;
     U8 del;
     U8 complement;
     U8 squash;
     U8 del;
     U8 complement;
@@ -9186,8 +9373,7 @@ S_scan_trans(pTHX_ char *start)
     }
   no_more:
 
     }
   no_more:
 
-    tbl = (short *)PerlMemShared_calloc(complement&&!del?258:256, sizeof(short));
-    o = newPVOP(nondestruct ? OP_TRANSR : OP_TRANS, 0, (char*)tbl);
+    o = newPVOP(nondestruct ? OP_TRANSR : OP_TRANS, 0, (char*)NULL);
     o->op_private &= ~OPpTRANS_ALL;
     o->op_private |= del|squash|complement|
       (DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
     o->op_private &= ~OPpTRANS_ALL;
     o->op_private |= del|squash|complement|
       (DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
@@ -9221,7 +9407,8 @@ S_scan_heredoc(pTHX_ register char *s)
     register char *d;
     register char *e;
     char *peek;
     register char *d;
     register char *e;
     char *peek;
-    const int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR));
+    const int outer = (PL_rsfp || PL_parser->filtered)
+                  && !(PL_lex_inwhat == OP_SCALAR);
 #ifdef PERL_MAD
     I32 stuffstart = s - SvPVX(PL_linestr);
     char *tstart;
 #ifdef PERL_MAD
     I32 stuffstart = s - SvPVX(PL_linestr);
     char *tstart;
@@ -9345,7 +9532,8 @@ S_scan_heredoc(pTHX_ register char *s)
     PL_multi_start = CopLINE(PL_curcop);
     PL_multi_open = PL_multi_close = '<';
     term = *PL_tokenbuf;
     PL_multi_start = CopLINE(PL_curcop);
     PL_multi_open = PL_multi_close = '<';
     term = *PL_tokenbuf;
-    if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
+    if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp
+     && !PL_parser->filtered) {
        char * const bufptr = PL_sublex_info.super_bufptr;
        char * const bufend = PL_sublex_info.super_bufend;
        char * const olds = s - SvCUR(herewas);
        char * const bufptr = PL_sublex_info.super_bufptr;
        char * const bufend = PL_sublex_info.super_bufend;
        char * const olds = s - SvCUR(herewas);
@@ -9528,7 +9716,7 @@ S_scan_inputsymbol(pTHX_ char *start)
 
     /* allow <Pkg'VALUE> or <Pkg::VALUE> */
     while (*d && (isALNUM_lazy_if(d,UTF) || *d == '\'' || *d == ':'))
 
     /* allow <Pkg'VALUE> or <Pkg::VALUE> */
     while (*d && (isALNUM_lazy_if(d,UTF) || *d == '\'' || *d == ':'))
-       d++;
+       d += UTF ? UTF8SKIP(d) : 1;
 
     /* If we've tried to read what we allow filehandles to look like, and
        there's still text left, then it must be a glob() and not a getline.
 
     /* If we've tried to read what we allow filehandles to look like, and
        there's still text left, then it must be a glob() and not a getline.
@@ -9722,7 +9910,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        termlen = 1;
     }
     else {
        termlen = 1;
     }
     else {
-       termcode = utf8_to_uvchr((U8*)s, &termlen);
+       termcode = utf8_to_uvchr_buf((U8*)s, (U8*)PL_bufend, &termlen);
        Copy(s, termstr, termlen, U8);
        if (!UTF8_IS_INVARIANT(term))
            has_utf8 = TRUE;
        Copy(s, termstr, termlen, U8);
        if (!UTF8_IS_INVARIANT(term))
            has_utf8 = TRUE;
@@ -9768,7 +9956,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                char * const svlast = SvEND(sv) - 1;
 
                for (; s < ns; s++) {
                char * const svlast = SvEND(sv) - 1;
 
                for (; s < ns; s++) {
-                   if (*s == '\n' && !PL_rsfp)
+                   if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
                        CopLINE_inc(PL_curcop);
                }
                if (!found)
                        CopLINE_inc(PL_curcop);
                }
                if (!found)
@@ -9835,7 +10023,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
        if (PL_multi_open == PL_multi_close) {
            for (; s < PL_bufend; s++,to++) {
                /* embedded newlines increment the current line number */
        if (PL_multi_open == PL_multi_close) {
            for (; s < PL_bufend; s++,to++) {
                /* embedded newlines increment the current line number */
-               if (*s == '\n' && !PL_rsfp)
+               if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
                    CopLINE_inc(PL_curcop);
                /* handle quoted delimiters */
                if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
                    CopLINE_inc(PL_curcop);
                /* handle quoted delimiters */
                if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
@@ -9867,7 +10055,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
            /* read until we run out of string, or we find the terminator */
            for (; s < PL_bufend; s++,to++) {
                /* embedded newlines increment the line count */
            /* read until we run out of string, or we find the terminator */
            for (; s < PL_bufend; s++,to++) {
                /* embedded newlines increment the line count */
-               if (*s == '\n' && !PL_rsfp)
+               if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
                    CopLINE_inc(PL_curcop);
                /* backslashes can escape the open or closing characters */
                if (*s == '\\' && s+1 < PL_bufend) {
                    CopLINE_inc(PL_curcop);
                /* backslashes can escape the open or closing characters */
                if (*s == '\\' && s+1 < PL_bufend) {
@@ -10037,7 +10225,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 
     switch (*s) {
     default:
 
     switch (*s) {
     default:
-      Perl_croak(aTHX_ "panic: scan_num");
+       Perl_croak(aTHX_ "panic: scan_num, *s=%d", *s);
 
     /* if it starts with a 0, it could be an octal number, a decimal in
        0.13 disguise, or a hexadecimal number, or a binary number. */
 
     /* if it starts with a 0, it could be an octal number, a decimal in
        0.13 disguise, or a hexadecimal number, or a binary number. */
@@ -10427,7 +10615,7 @@ S_scan_formline(pTHX_ register char *s)
                break;
             }
        }
                break;
             }
        }
-       if (PL_in_eval && !PL_rsfp) {
+       if (PL_in_eval && !PL_rsfp && !PL_parser->filtered) {
            eol = (char *) memchr(s,'\n',PL_bufend-s);
            if (!eol++)
                eol = PL_bufend;
            eol = (char *) memchr(s,'\n',PL_bufend-s);
            if (!eol++)
                eol = PL_bufend;
@@ -10458,7 +10646,7 @@ S_scan_formline(pTHX_ register char *s)
              break;
        }
        s = (char*)eol;
              break;
        }
        s = (char*)eol;
-       if (PL_rsfp) {
+       if (PL_rsfp || PL_parser->filtered) {
            bool got_some;
 #ifdef PERL_MAD
            if (PL_madskills) {
            bool got_some;
 #ifdef PERL_MAD
            if (PL_madskills) {
@@ -10552,14 +10740,14 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
 #pragma segment Perl_yylex
 #endif
 static int
 #pragma segment Perl_yylex
 #endif
 static int
-S_yywarn(pTHX_ const char *const s)
+S_yywarn(pTHX_ const char *const s, U32 flags)
 {
     dVAR;
 
     PERL_ARGS_ASSERT_YYWARN;
 
     PL_in_eval |= EVAL_WARNONLY;
 {
     dVAR;
 
     PERL_ARGS_ASSERT_YYWARN;
 
     PL_in_eval |= EVAL_WARNONLY;
-    yyerror(s);
+    yyerror_pv(s, flags);
     PL_in_eval &= ~EVAL_WARNONLY;
     return 0;
 }
     PL_in_eval &= ~EVAL_WARNONLY;
     return 0;
 }
@@ -10567,17 +10755,32 @@ S_yywarn(pTHX_ const char *const s)
 int
 Perl_yyerror(pTHX_ const char *const s)
 {
 int
 Perl_yyerror(pTHX_ const char *const s)
 {
+    PERL_ARGS_ASSERT_YYERROR;
+    return yyerror_pvn(s, strlen(s), 0);
+}
+
+int
+Perl_yyerror_pv(pTHX_ const char *const s, U32 flags)
+{
+    PERL_ARGS_ASSERT_YYERROR_PV;
+    return yyerror_pvn(s, strlen(s), flags);
+}
+
+int
+Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
+{
     dVAR;
     dVAR;
-    const char *where = NULL;
     const char *context = NULL;
     int contlen = -1;
     SV *msg;
     const char *context = NULL;
     int contlen = -1;
     SV *msg;
+    SV * const where_sv = newSVpvs_flags("", SVs_TEMP);
     int yychar  = PL_parser->yychar;
     int yychar  = PL_parser->yychar;
+    U32 is_utf8 = flags & SVf_UTF8;
 
 
-    PERL_ARGS_ASSERT_YYERROR;
+    PERL_ARGS_ASSERT_YYERROR_PVN;
 
     if (!yychar || (yychar == ';' && !PL_rsfp))
 
     if (!yychar || (yychar == ';' && !PL_rsfp))
-       where = "at EOF";
+       sv_catpvs(where_sv, "at EOF");
     else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
       PL_bufptr - PL_oldoldbufptr < 200 && PL_oldoldbufptr != PL_oldbufptr &&
       PL_oldbufptr != PL_bufptr) {
     else if (PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr &&
       PL_bufptr - PL_oldoldbufptr < 200 && PL_oldoldbufptr != PL_oldbufptr &&
       PL_oldbufptr != PL_bufptr) {
@@ -10612,18 +10815,18 @@ Perl_yyerror(pTHX_ const char *const s)
        contlen = PL_bufptr - PL_oldbufptr;
     }
     else if (yychar > 255)
        contlen = PL_bufptr - PL_oldbufptr;
     }
     else if (yychar > 255)
-       where = "next token ???";
+       sv_catpvs(where_sv, "next token ???");
     else if (yychar == -2) { /* YYEMPTY */
        if (PL_lex_state == LEX_NORMAL ||
           (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
     else if (yychar == -2) { /* YYEMPTY */
        if (PL_lex_state == LEX_NORMAL ||
           (PL_lex_state == LEX_KNOWNEXT && PL_lex_defer == LEX_NORMAL))
-           where = "at end of line";
+           sv_catpvs(where_sv, "at end of line");
        else if (PL_lex_inpat)
        else if (PL_lex_inpat)
-           where = "within pattern";
+           sv_catpvs(where_sv, "within pattern");
        else
        else
-           where = "within string";
+           sv_catpvs(where_sv, "within string");
     }
     else {
     }
     else {
-       SV * const where_sv = newSVpvs_flags("next char ", SVs_TEMP);
+       sv_catpvs(where_sv, "next char ");
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
        else if (isPRINT_LC(yychar)) {
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
        else if (isPRINT_LC(yychar)) {
@@ -10632,15 +10835,16 @@ Perl_yyerror(pTHX_ const char *const s)
        }
        else
            Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
        }
        else
            Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255);
-       where = SvPVX_const(where_sv);
     }
     }
-    msg = sv_2mortal(newSVpv(s, 0));
+    msg = sv_2mortal(newSVpvn_flags(s, len, is_utf8));
     Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
         OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
     if (context)
     Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ",
         OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
     if (context)
-       Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
+       Perl_sv_catpvf(aTHX_ msg, "near \"%"SVf"\"\n",
+                            SVfARG(newSVpvn_flags(context, contlen,
+                                        SVs_TEMP | (UTF ? SVf_UTF8 : 0))));
     else
     else
-       Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
+       Perl_sv_catpvf(aTHX_ msg, "%"SVf"\n", SVfARG(where_sv));
     if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {
         Perl_sv_catpvf(aTHX_ msg,
         "  (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
     if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) {
         Perl_sv_catpvf(aTHX_ msg,
         "  (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
@@ -10681,6 +10885,7 @@ S_swallow_bom(pTHX_ U8 *s)
        if (s[1] == 0xFE) {
            /* UTF-16 little-endian? (or UTF-32LE?) */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
        if (s[1] == 0xFE) {
            /* UTF-16 little-endian? (or UTF-32LE?) */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
+               /* diag_listed_as: Unsupported script encoding %s */
                Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
 #ifndef PERL_NO_UTF16_FILTER
            if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
                Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
 #ifndef PERL_NO_UTF16_FILTER
            if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
@@ -10689,6 +10894,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, TRUE);
            }
 #else
                s = add_utf16_textfilter(s, TRUE);
            }
 #else
+           /* diag_listed_as: Unsupported script encoding %s */
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
        }
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
        }
@@ -10702,6 +10908,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, FALSE);
            }
 #else
                s = add_utf16_textfilter(s, FALSE);
            }
 #else
+           /* diag_listed_as: Unsupported script encoding %s */
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
        }
            Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
        }
@@ -10717,6 +10924,7 @@ S_swallow_bom(pTHX_ U8 *s)
             if (s[1] == 0) {
                  if (s[2] == 0xFE && s[3] == 0xFF) {
                       /* UTF-32 big-endian */
             if (s[1] == 0) {
                  if (s[2] == 0xFE && s[3] == 0xFF) {
                       /* UTF-32 big-endian */
+                      /* diag_listed_as: Unsupported script encoding %s */
                       Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE");
                  }
             }
                       Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE");
                  }
             }
@@ -10728,6 +10936,7 @@ S_swallow_bom(pTHX_ U8 *s)
                  if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
                  s = add_utf16_textfilter(s, FALSE);
 #else
                  if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
                  s = add_utf16_textfilter(s, FALSE);
 #else
+                 /* diag_listed_as: Unsupported script encoding %s */
                  Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
             }
                  Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
             }
@@ -10750,6 +10959,7 @@ S_swallow_bom(pTHX_ U8 *s)
              if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
              s = add_utf16_textfilter(s, TRUE);
 #else
              if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
              s = add_utf16_textfilter(s, TRUE);
 #else
+             /* diag_listed_as: Unsupported script encoding %s */
              Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
         }
              Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
         }
@@ -10966,6 +11176,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
                    rev += (*end - '0') * mult;
                    mult *= 10;
                    if (orev > rev)
                    rev += (*end - '0') * mult;
                    mult *= 10;
                    if (orev > rev)
+                       /* diag_listed_as: Integer overflow in %s number */
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                         "Integer overflow in decimal number");
                }
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                         "Integer overflow in decimal number");
                }
@@ -11284,15 +11495,10 @@ Perl_parse_label(pTHX_ U32 flags)
     if (PL_lex_state == LEX_KNOWNEXT) {
        PL_parser->yychar = yylex();
        if (PL_parser->yychar == LABEL) {
     if (PL_lex_state == LEX_KNOWNEXT) {
        PL_parser->yychar = yylex();
        if (PL_parser->yychar == LABEL) {
-           char *lpv = pl_yylval.pval;
-           STRLEN llen = strlen(lpv);
            SV *lsv;
            PL_parser->yychar = YYEMPTY;
            lsv = newSV_type(SVt_PV);
            SV *lsv;
            PL_parser->yychar = YYEMPTY;
            lsv = newSV_type(SVt_PV);
-           SvPV_set(lsv, lpv);
-           SvCUR_set(lsv, llen);
-           SvLEN_set(lsv, llen+1);
-           SvPOK_on(lsv);
+           sv_copypv(lsv, cSVOPx(pl_yylval.opval)->op_sv);
            return lsv;
        } else {
            yyunlex();
            return lsv;
        } else {
            yyunlex();
@@ -11300,17 +11506,12 @@ Perl_parse_label(pTHX_ U32 flags)
        }
     } else {
        char *s, *t;
        }
     } else {
        char *s, *t;
-       U8 c;
        STRLEN wlen, bufptr_pos;
        lex_read_space(0);
        t = s = PL_bufptr;
        STRLEN wlen, bufptr_pos;
        lex_read_space(0);
        t = s = PL_bufptr;
-       c = (U8)*s;
-       if (!isIDFIRST_A(c))
+        if (!isIDFIRST_lazy_if(s, UTF))
            goto no_label;
            goto no_label;
-       do {
-           c = (U8)*++t;
-       } while(isWORDCHAR_A(c));
-       wlen = t - s;
+       t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen);
        if (word_takes_any_delimeter(s, wlen))
            goto no_label;
        bufptr_pos = s - SvPVX(PL_linestr);
        if (word_takes_any_delimeter(s, wlen))
            goto no_label;
        bufptr_pos = s - SvPVX(PL_linestr);
@@ -11322,7 +11523,7 @@ Perl_parse_label(pTHX_ U32 flags)
            PL_oldoldbufptr = PL_oldbufptr;
            PL_oldbufptr = s;
            PL_bufptr = t+1;
            PL_oldoldbufptr = PL_oldbufptr;
            PL_oldbufptr = s;
            PL_bufptr = t+1;
-           return newSVpvn(s, wlen);
+           return newSVpvn_flags(s, wlen, UTF ? SVf_UTF8 : 0);
        } else {
            PL_bufptr = s;
            no_label:
        } else {
            PL_bufptr = s;
            no_label:
@@ -11415,29 +11616,12 @@ Perl_parse_stmtseq(pTHX_ U32 flags)
     return stmtseqop;
 }
 
     return stmtseqop;
 }
 
-void
-Perl_munge_qwlist_to_paren_list(pTHX_ OP *qwlist)
-{
-    PERL_ARGS_ASSERT_MUNGE_QWLIST_TO_PAREN_LIST;
-    deprecate("qw(...) as parentheses");
-    force_next((4<<24)|')');
-    if (qwlist->op_type == OP_STUB) {
-       op_free(qwlist);
-    }
-    else {
-       start_force(PL_curforce);
-       NEXTVAL_NEXTTOKE.opval = qwlist;
-       force_next(THING);
-    }
-    force_next((2<<24)|'(');
-}
-
 /*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
 /*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */
  */
Unnamed repository; edit this file 'description' to name the repository.