diff options
| -rw-r--r-- | cop.h | 2 | ||||
| -rw-r--r-- | op.h | 1 | ||||
| -rw-r--r-- | perl.c | 6 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | regcomp.c | 11 | ||||
| -rw-r--r-- | regexec.c | 1 | ||||
| -rw-r--r-- | toke.c | 12 |
7 files changed, 26 insertions, 11 deletions
@@ -1048,6 +1048,7 @@ L<perlcall>. Perl_magic_methcall(). */ #define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling Perl_magic_methcall(). */ +#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -1055,6 +1056,7 @@ L<perlcall>. #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */ #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ #define EVAL_INREQUIRE 8 /* The code is being required. */ +#define EVAL_RE_REPARSING 0x10 /* eval_sv() called with G_RE_REPARSING */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. @@ -308,6 +308,7 @@ Deprecated. Use C<GIMME_V> instead. #define OPpEVAL_UNICODE 4 #define OPpEVAL_BYTES 8 #define OPpEVAL_COPHH 16 /* Construct %^H from cop hints */ +#define OPpEVAL_RE_REPARSING 32 /* eval_sv(..., G_RE_REPARSING) */ /* Private for OP_CALLER, OP_WANTARRAY and OP_RUNCV */ #define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */ @@ -2808,8 +2808,10 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) myop.op_flags |= OP_GIMME_REVERSE(flags); if (flags & G_KEEPERR) myop.op_flags |= OPf_SPECIAL; - if (PL_reg_state.re_reparsing) - myop.op_private = OPpEVAL_COPHH; + assert (! (!!(PL_reg_state.re_reparsing ^ !!(flags & G_RE_REPARSING)))); + + if (flags & G_RE_REPARSING) + myop.op_private = (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING); /* fail now; otherwise we could fail after the JMPENV_PUSH but * before a PUSHEVAL, which corrupts the stack after a croak */ @@ -3358,7 +3358,9 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) PL_in_eval = (in_require ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL)) - : EVAL_INEVAL); + : (EVAL_INEVAL | + ((PL_op->op_private & OPpEVAL_RE_REPARSING) + ? EVAL_RE_REPARSING : 0))); PUSHMARK(SP); @@ -5003,11 +5003,11 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, SAVETMPS; save_re_context(); PUSHSTACKi(PERLSI_REQUIRE); - /* this causes the toker to collapse \\ into \ when parsing - * qr''; normally only q'' does this. It also alters hints - * handling */ + /* G_RE_REPARSING causes the toker to collapse \\ into \ when + * parsing qr''; normally only q'' does this. It also alters + * hints handling */ PL_reg_state.re_reparsing = TRUE; - eval_sv(sv, G_SCALAR); + eval_sv(sv, G_SCALAR|G_RE_REPARSING); SvREFCNT_dec_NN(sv); SPAGAIN; qr_ref = POPs; @@ -5634,6 +5634,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, * from the compile flags. */ + assert (!(!!(PL_reg_state.re_reparsing ^ !!(PL_in_eval & EVAL_RE_REPARSING)))); if ( old_re && !recompile && !!RX_UTF8(old_re) == !!RExC_utf8 @@ -5653,7 +5654,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, else if ((pm_flags & PMf_USE_RE_EVAL) /* this second condition covers the non-regex literal case, * i.e. $foo =~ '(?{})'. */ - || ( !PL_reg_state.re_reparsing && IN_PERL_COMPILETIME + || ( !(PL_in_eval & EVAL_RE_REPARSING) && IN_PERL_COMPILETIME && (PL_hints & HINT_RE_EVAL)) ) runtime_code = S_has_runtime_code(aTHX_ pRExC_state, expr, pm_flags, @@ -4879,6 +4879,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) Copy(&PL_reg_state, &saved_state, 1, struct re_save_state); PL_reg_state.re_reparsing = FALSE; + PL_in_eval &= ~EVAL_RE_REPARSING; if (!caller_cv) caller_cv = find_runcv(NULL); @@ -9047,7 +9047,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 +9504,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,8 +9514,13 @@ S_scan_pat(pTHX_ char *start, I32 type) PERL_ARGS_ASSERT_SCAN_PAT; + assert (!(!!(PL_reg_state.re_reparsing ^ !!(PL_in_eval & EVAL_RE_REPARSING)))); + s = scan_str(start,!!PL_madskills,FALSE, (PL_in_eval & EVAL_RE_REPARSING), + TRUE /* look for escaped bracketed metas */ ); + /* this was only needed for the initial scan_str; set it to false * so that any (?{}) code blocks etc are parsed normally */ + PL_in_eval &= ~EVAL_RE_REPARSING; PL_reg_state.re_reparsing = FALSE; if (!s) { const char * const delimiter = skipspace(start); |