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.

5 files changed, 12 insertions, 5 deletions

diff --git a/dump.c b/dump.c
index a620737650..ce3386450b 100644
--- 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_CODELIST_PRIVATE, ",CODELIST_PRIVATE"}
+    {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
+    {PMf_IS_QR, ",IS_QR"}
 };
 
 static SV *
diff --git a/op.c b/op.c
index f8d152fb1e..fe3835aa46 100644
--- 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) {
-	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)
diff --git a/op.h b/op.h
index 06437d475f..b7e8614c99 100644
--- 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))
 
-#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
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 24a0d3e5d0..1b0422a10f 100644
--- 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,
-		(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));
diff --git a/regcomp.c b/regcomp.c
index b1a1ee98b3..17e586280e 100644
--- 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;
-    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;
     }