Eliminate PL_reg_state.re_reparsing, part 1

PL_reg_state.re_reparsing is a hacky flag used to allow runtime
code blocks to be included in patterns. Basically, since code blocks
are now handled by the perl parser within literal patterns, runtime
patterns are handled by taking the (assembled at runtime) pattern,
and feeding it back through the parser via the equivalent of
    eval q{qr'the_pattern'},
so that run-time (?{..})'s appear to be literal code blocks.
When this happens, the global flag PL_reg_state.re_reparsing is set,
which modifies lexing and parsing in minor ways (such as whether \\ is
stripped).

Now, I'm in the slow process of trying to eliminate global regex state
(i.e. gradually removing the fields of PL_reg_state), and also a change
which will be coming a few commits ahead requires the info which this flag
indicates to linger for longer (currently it is cleared immediately after
the call to scan_str().

For those two reasons, this commit adds a new mechanism to indicate this:
a new flag to eval_sv(), G_RE_REPARSING (which sets OPpEVAL_RE_REPARSING
in the entereval op), which sets the EVAL_RE_REPARSING bit in PL_in_eval.

Its still a yukky global flag hack, but its a *different* global flag hack
now.

For this commit, we add the new flag(s) but keep the old
PL_reg_state.re_reparsing flag and assert that the two mechanisms always
match. The next commit will remove re_reparsing.

diff --git a/cop.h b/cop.h
index 086cd22..b20eddb 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -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.

diff --git a/op.h b/op.h
index 8b87a9c..7c5030d 100644 (file)
--- a/op.h
+++ b/op.h
@@ -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) */

diff --git a/perl.c b/perl.c
index 87d98dc..9f41768 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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 */

diff --git a/pp_ctl.c b/pp_ctl.c
index f518bc2..721a8a9 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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);
 

diff --git a/regcomp.c b/regcomp.c
index f680717..9873aaf 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -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,

diff --git a/regexec.c b/regexec.c
index d376e26..017cbff 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -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);

diff --git a/toke.c b/toke.c
index 275c957..929bdee 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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);