perldelta: "single character" is clearer than "length one"

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 275c957..f1d09ef 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2525,6 +2525,7 @@ S_sublex_push(pTHX)
     SAVEGENERICPV(PL_lex_brackstack);
     SAVEGENERICPV(PL_lex_casestack);
     SAVEGENERICPV(PL_parser->lex_shared);
+    SAVEBOOL(PL_parser->lex_re_reparsing);
 
     /* The here-doc parser needs to be able to peek into outer lexing
        scopes to find the body of the here-doc.  So we put PL_linestr and
@@ -2568,6 +2569,9 @@ S_sublex_push(pTHX)
     else
        PL_lex_inpat = NULL;
 
+    PL_parser->lex_re_reparsing = cBOOL(PL_in_eval & EVAL_RE_REPARSING);
+    PL_in_eval &= ~EVAL_RE_REPARSING;
+
     return '(';
 }
 
@@ -3751,7 +3755,9 @@ S_scan_const(pTHX_ char *start)
     /* return the substring (via pl_yylval) only if we parsed anything */
     if (s > PL_bufptr) {
        SvREFCNT_inc_simple_void_NN(sv);
-       if ( PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) ) {
+       if (   (PL_hints & ( PL_lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ))
+            && ! PL_parser->lex_re_reparsing)
+        {
            const char *const key = PL_lex_inpat ? "qr" : "q";
            const STRLEN keylen = PL_lex_inpat ? 2 : 1;
            const char *type;
@@ -4839,7 +4845,10 @@ Perl_yylex(pTHX)
        DEBUG_T({ if(*PL_bufptr != '(') PerlIO_printf(Perl_debug_log,
               "### Interpolated variable\n"); });
        PL_expect = XTERM;
-       PL_lex_dojoin = (*PL_bufptr == '@');
+        /* for /@a/, we leave the joining for the regex engine to do
+         * (unless we're within \Q etc) */
+       PL_lex_dojoin = (*PL_bufptr == '@'
+                            && (!PL_lex_inpat || PL_lex_casemods));
        PL_lex_state = LEX_INTERPNORMAL;
        if (PL_lex_dojoin) {
            start_force(PL_curforce);
@@ -8554,6 +8563,7 @@ Perl_yylex(pTHX)
 #ifdef PERL_MAD
                    PL_thistoken = subtoken;
                    s = d;
+                    PERL_UNUSED_VAR(tboffset);
 #else
                    if (have_name)
                        (void) force_word(PL_oldbufptr + tboffset, WORD,
@@ -8676,6 +8686,7 @@ Perl_yylex(pTHX)
                force_next(0);
 
                PL_thistoken = subtoken;
+                PERL_UNUSED_VAR(have_proto);
 #else
                if (have_proto) {
                    NEXTVAL_NEXTTOKE.opval =
@@ -9047,7 +9058,9 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
     }
 }
 
-/* Either returns sv, or mortalizes/frees sv and returns a new SV*.
+/* S_new_constant(): do any overload::constant lookup.
+
+   Either returns sv, or mortalizes/frees sv and returns a new SV*.
    Best used as sv=new_constant(..., sv, ...).
    If s, pv are NULL, calls subroutine with one argument,
    and <type> is used with error messages only.
@@ -9502,8 +9515,7 @@ S_scan_pat(pTHX_ char *start, I32 type)
 {
     dVAR;
     PMOP *pm;
-    char *s = scan_str(start,!!PL_madskills,FALSE, PL_reg_state.re_reparsing,
-                       TRUE /* look for escaped bracketed metas */ );
+    char *s;
     const char * const valid_flags =
        (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS);
     char charset = '\0';    /* character set modifier */
@@ -9513,9 +9525,9 @@ S_scan_pat(pTHX_ char *start, I32 type)
 
     PERL_ARGS_ASSERT_SCAN_PAT;
 
-    /* this was only needed for the initial scan_str; set it to false
-     * so that any (?{}) code blocks etc are parsed normally */
-    PL_reg_state.re_reparsing = FALSE;
+    s = scan_str(start,!!PL_madskills,FALSE, (PL_in_eval & EVAL_RE_REPARSING),
+                       TRUE /* look for escaped bracketed metas */ );
+
     if (!s) {
        const char * const delimiter = skipspace(start);
        Perl_croak(aTHX_