add PMf_IS_QR flag

This indicates that a particular PMOP is in fact OP_QR. We should of
course be able to tell this from op_type, but the regex-compiling API
only gets passed op_flags.

This then allows us to fix a bug where we were deciding during compilation
whether to hang on to the code_blocks based on whether the PMOP was
PMf_HAS_CV rather than PMf_IS_QR; the latter implies the former, but not
the other way round.

diff --git a/dump.c b/dump.c
index a620737..ce33864 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -640,7 +640,8 @@ const struct flag_to_name pmflags_flags_names[] = {
     {PMf_EVAL, ",EVAL"},
     {PMf_NONDESTRUCT, ",NONDESTRUCT"},
     {PMf_HAS_CV, ",HAS_CV"},
     {PMf_EVAL, ",EVAL"},
     {PMf_NONDESTRUCT, ",NONDESTRUCT"},
     {PMf_HAS_CV, ",HAS_CV"},

-    {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"}
+    {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
+    {PMf_IS_QR, ",IS_QR"}

 };
 
 static SV *
 };
 
 static SV *

diff --git a/op.c b/op.c
index f8d152f..fe3835a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4360,7 +4360,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
     assert(floor==0 || (pm->op_pmflags & PMf_HAS_CV));
 
     if (is_compiletime) {
     assert(floor==0 || (pm->op_pmflags & PMf_HAS_CV));
 
     if (is_compiletime) {

-       U32 pm_flags = pm->op_pmflags & (RXf_PMf_COMPILETIME|PMf_HAS_CV);
+       U32 pm_flags = pm->op_pmflags &
+               (RXf_PMf_COMPILETIME|PMf_HAS_CV|PMf_IS_QR);

        regexp_engine *eng = current_re_engine();
 
        if (o->op_flags & OPf_SPECIAL)
        regexp_engine *eng = current_re_engine();
 
        if (o->op_flags & OPf_SPECIAL)

diff --git a/op.h b/op.h
index 06437d4..b7e8614 100644 (file)
--- a/op.h
+++ b/op.h
@@ -441,7 +441,12 @@ struct pmop {
  * code within another sub, with different pad etc */
 #define PMf_CODELIST_PRIVATE   (1<<(PMf_BASE_SHIFT+11))
 
  * code within another sub, with different pad etc */
 #define PMf_CODELIST_PRIVATE   (1<<(PMf_BASE_SHIFT+11))
 

-#if PMf_BASE_SHIFT+11 > 31
+/* the PMOP is a QR (we should be able to detect that from the op type,
+ * but the regex compilation API passes just the pm flags, not the op
+ * itself */
+#define PMf_IS_QR      (1<<(PMf_BASE_SHIFT+12))
+
+#if PMf_BASE_SHIFT+12 > 31

 #   error Too many PMf_ bits used.  See above and regnodes.h for any spare in middle
 #endif
 
 #   error Too many PMf_ bits used.  See above and regnodes.h for any spare in middle
 #endif
 

diff --git a/pp_ctl.c b/pp_ctl.c
index 24a0d3e..1b0422a 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -115,7 +115,7 @@ PP(pp_regcomp)
 
     new_re = re_op_compile(args, nargs, pm->op_code_list, eng, re,
                &is_bare_re,
 
     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)));
+               (pm->op_pmflags & (RXf_PMf_COMPILETIME|PMf_HAS_CV|PMf_IS_QR)));

     if (pm->op_pmflags & PMf_HAS_CV)
        ((struct regexp *)SvANY(new_re))->qr_anoncv
                        = (CV*) SvREFCNT_inc(PAD_SV(PL_op->op_targ));
     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/regcomp.c b/regcomp.c
index b1a1ee9..17e5862 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5550,7 +5550,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     RXi_SET( r, ri );
     r->engine= RE_ENGINE_PTR;
     r->extflags = pm_flags;
     RXi_SET( r, ri );
     r->engine= RE_ENGINE_PTR;
     r->extflags = pm_flags;

-    if (orig_pm_flags & PMf_HAS_CV) {
+    if (orig_pm_flags & PMf_IS_QR) {

        ri->code_blocks = pRExC_state->code_blocks;
        ri->num_code_blocks = pRExC_state->num_code_blocks;
     }
        ri->code_blocks = pRExC_state->code_blocks;
        ri->num_code_blocks = pRExC_state->num_code_blocks;
     }