re_op_compile(): split flags into two arguments

There are two sets of regex-related flags; the RXf_* which
end up in the extflags field of a REGEXP, and the PMf_*, which
are in the op_pmflags field of a PMOP.

Since I added the PMf_HAS_CV and PMf_IS_QR flags, I've been conflating
these two meanings in the single flags arg to re_op_compile(), which meant
that some bits were being misinterpreted. The only test that was failing
was peek.t, but it may have quietly broken other things that simply
weren't tested for (for example PMf_HAS_CV and RXf_SPLIT share the same
value, so something with split qr/(?{...})/ might get messed up).

So, split this arg into two; one for the RXf* flags, and one for the PMf_*
flags.

The public regexp API continues to have only a single flags arg,
which should only be accepting RXf_* flags.

diff --git a/embed.fnc b/embed.fnc
index f003281..fc93e49 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1063,7 +1063,7 @@ p |REGEXP*|re_op_compile  |NULLOK SV ** const patternp \
                                |NULLOK const regexp_engine* eng \
                                |NULLOK REGEXP *VOL old_re \
                                |NULLOK int *is_bare_re \
-                               |U32 rx_flags
+                               |U32 rx_flags|U32 pm_flags
 Ap     |REGEXP*|re_compile     |NN SV * const pattern|U32 orig_rx_flags
 Ap     |char*  |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \
                                |NN char* strend|const U32 flags \

diff --git a/embed.h b/embed.h
index f85d44c..173c193 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1175,7 +1175,7 @@
 #define parser_free(a)         Perl_parser_free(aTHX_ a)
 #define peep(a)                        Perl_peep(aTHX_ a)
 #define pmruntime(a,b,c,d)     Perl_pmruntime(aTHX_ a,b,c,d)
-#define re_op_compile(a,b,c,d,e,f,g)   Perl_re_op_compile(aTHX_ a,b,c,d,e,f,g)
+#define re_op_compile(a,b,c,d,e,f,g,h) Perl_re_op_compile(aTHX_ a,b,c,d,e,f,g,h)
 #define refcounted_he_chain_2hv(a,b)   Perl_refcounted_he_chain_2hv(aTHX_ a,b)
 #define refcounted_he_fetch_pv(a,b,c,d)        Perl_refcounted_he_fetch_pv(aTHX_ a,b,c,d)
 #define refcounted_he_fetch_pvn(a,b,c,d,e)     Perl_refcounted_he_fetch_pvn(aTHX_ a,b,c,d,e)

diff --git a/op.c b/op.c
index fe3835a..d729bff 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4360,12 +4360,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
     assert(floor==0 || (pm->op_pmflags & PMf_HAS_CV));
 
     if (is_compiletime) {
-       U32 pm_flags = pm->op_pmflags &
-               (RXf_PMf_COMPILETIME|PMf_HAS_CV|PMf_IS_QR);
+       U32 rx_flags = pm->op_pmflags & RXf_PMf_COMPILETIME;
        regexp_engine *eng = current_re_engine();
 
        if (o->op_flags & OPf_SPECIAL)
-           pm_flags |= RXf_SPLIT;
+           rx_flags |= RXf_SPLIT;
 
        if (!has_code || (eng && eng != &PL_core_reg_engine)) {
            /* compile-time simple constant pattern */
@@ -4413,7 +4412,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
                pat = newSVpvn_flags(p, len, SVs_TEMP);
            }
 
-           PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
+           PM_SETRE(pm, CALLREGCOMP(pat, rx_flags));
 #ifdef PERL_MAD
            op_getmad(expr,(OP*)pm,'e');
 #else
@@ -4422,8 +4421,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
        }
        else {
            /* compile-time pattern that includes literal code blocks */
-           REGEXP* re =
-                   re_op_compile(NULL, 0, expr, NULL, NULL, NULL, pm_flags);
+           REGEXP* re = re_op_compile(NULL, 0, expr, NULL, NULL, NULL,
+                                       rx_flags, pm->op_pmflags);
            PM_SETRE(pm, re);
            if (pm->op_pmflags & PMf_HAS_CV) {
                CV *cv;

diff --git a/pp_ctl.c b/pp_ctl.c
index 1b0422a..f816b95 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -115,7 +115,8 @@ PP(pp_regcomp)
 
     new_re = re_op_compile(args, nargs, pm->op_code_list, eng, re,
                &is_bare_re,
-               (pm->op_pmflags & (RXf_PMf_COMPILETIME|PMf_HAS_CV|PMf_IS_QR)));
+               (pm->op_pmflags & RXf_PMf_COMPILETIME),
+               pm->op_pmflags);
     if (pm->op_pmflags & PMf_HAS_CV)
        ((struct regexp *)SvANY(new_re))->qr_anoncv
                        = (CV*) SvREFCNT_inc(PAD_SV(PL_op->op_targ));

diff --git a/proto.h b/proto.h
index 1a1f095..772c904 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3150,7 +3150,7 @@ PERL_CALLCONV SV* Perl_re_intuit_string(pTHX_ REGEXP  *const r)
 #define PERL_ARGS_ASSERT_RE_INTUIT_STRING      \
        assert(r)
 
-PERL_CALLCONV REGEXP*  Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, OP *expr, const regexp_engine* eng, REGEXP *VOL old_re, int *is_bare_re, U32 rx_flags);
+PERL_CALLCONV REGEXP*  Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, OP *expr, const regexp_engine* eng, REGEXP *VOL old_re, int *is_bare_re, U32 rx_flags, U32 pm_flags);
 PERL_CALLCONV Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;

diff --git a/regcomp.c b/regcomp.c
index 832dd47..17fb4e0 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -111,7 +111,8 @@
 
 
 typedef struct RExC_state_t {
-    U32                flags;                  /* are we folding, multilining? */
+    U32                flags;                  /* RXf_* are we folding, multilining? */
+    U32                pm_flags;               /* PMf_* stuff from the calling PMOP */
     char       *precomp;               /* uncompiled string. */
     REGEXP     *rx_sv;                 /* The SV that is the regexp. */
     regexp     *rx;                    /* perl core regexp structure */
@@ -169,6 +170,7 @@ typedef struct RExC_state_t {
 } RExC_state_t;
 
 #define RExC_flags     (pRExC_state->flags)
+#define RExC_pm_flags  (pRExC_state->pm_flags)
 #define RExC_precomp   (pRExC_state->precomp)
 #define RExC_rx_sv     (pRExC_state->rx_sv)
 #define RExC_rx                (pRExC_state->rx)
@@ -4967,7 +4969,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 rx_flags)
     SV *pat = pattern; /* defeat constness! */
     PERL_ARGS_ASSERT_RE_COMPILE;
     return Perl_re_op_compile(aTHX_ &pat, 1, NULL,
-                                   NULL, NULL, NULL, rx_flags);
+                                   NULL, NULL, NULL, rx_flags, 0);
 }
 
 
@@ -4995,6 +4997,11 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 rx_flags)
  * arg list reduced (after overloading) to a single bare regex which has
  * been returned (i.e. /$qr/).
  *
+ * orig_rx_flags contains RXf_* flags. See perlreapi.pod for more details.
+ *
+ * pm_flags contains the PMf_* flags from the calling PMOP. Currently
+ * we're only interested in PMf_HAS_CV and PMf_IS_QR.
+ *
  * We can't allocate space until we know how big the compiled form will be,
  * but we can't compile it (and thus know how big it is) until we've got a
  * place to put the code.  So we cheat:  we compile it twice, once with code
@@ -5011,7 +5018,7 @@ Perl_re_compile(pTHX_ SV * const pattern, U32 rx_flags)
 REGEXP *
 Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                    OP *expr, const regexp_engine* eng, REGEXP *VOL old_re,
-                    int *is_bare_re, U32 orig_rx_flags)
+                    int *is_bare_re, U32 orig_rx_flags, U32 pm_flags)
 {
     dVAR;
     REGEXP *rx;
@@ -5458,6 +5465,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 
     RExC_precomp = exp;
     RExC_flags = rx_flags;
+    RExC_pm_flags = pm_flags;
     RExC_sawback = 0;
 
     RExC_seen = 0;
@@ -5550,7 +5558,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     RXi_SET( r, ri );
     r->engine= RE_ENGINE_PTR;
     r->extflags = rx_flags;
-    if (orig_rx_flags & PMf_IS_QR) {
+    if (pm_flags & PMf_IS_QR) {
        ri->code_blocks = pRExC_state->code_blocks;
        ri->num_code_blocks = pRExC_state->num_code_blocks;
     }
@@ -5650,6 +5658,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
 
     /* Second pass: emit code. */
     RExC_flags = rx_flags;     /* don't let top level (?i) bleed */
+    RExC_pm_flags = pm_flags;
     RExC_parse = exp;
     RExC_end = xend;
     RExC_naughty = 0;
@@ -8349,7 +8358,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                        }
                        else {
                            n = add_data(pRExC_state, 1,
-                                  (RExC_flags & PMf_HAS_CV) ? "L" : "l");
+                                  (RExC_pm_flags & PMf_HAS_CV) ? "L" : "l");
                            RExC_rxi->data->data[n] = (void*)o->op_next;
                        }
                    }