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.

6 files changed, 24 insertions, 15 deletions

diff --git a/embed.fnc b/embed.fnc
index f0032819c5..fc93e49698 100644
--- 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 f85d44cc73..173c19390a 100644
--- 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 fe3835aa46..d729bfff16 100644
--- 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 1b0422a10f..f816b95cfa 100644
--- 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 1a1f0958ba..772c90432a 100644
--- 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 832dd47b7b..17fb4e0a66 100644
--- 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;
 			}
 		    }