propagate 'use re eval' into return from (??{})

(??{}) returns a string which needs to be put through the regex compiler,
and which may also contain (?{...}) - so any 'use re eval' in scope needs
to be propagated into the inner environment. Achieve this by adding a new
private flag - PREGf_USE_RE_EVAL - to the regex to indicate the use is in
scope, and modify how the call to compile the inner pattern is done,
to allow the use state to be passed in.

5 files changed, 30 insertions, 3 deletions

diff --git a/op.c b/op.c
index 304fb5d37a..0ff8f6791f 100644
--- a/op.c
+++ b/op.c
@@ -4396,7 +4396,10 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 	else {
 	    /* compile-time pattern that includes literal code blocks */
 	    REGEXP* re = eng->op_comp(aTHX_ NULL, 0, expr, eng, NULL, NULL,
-					rx_flags, pm->op_pmflags);
+			rx_flags,
+			(pm->op_pmflags |
+			    ((PL_hints & HINT_RE_EVAL) ? PMf_USE_RE_EVAL : 0))
+		    );
 	    PM_SETRE(pm, re);
 	    if (pm->op_pmflags & PMf_HAS_CV) {
 		CV *cv;
diff --git a/regcomp.c b/regcomp.c
index d8dc9af84a..a81dc58fe0 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -6359,6 +6359,8 @@ reStudy:
 	r->intflags |= PREGf_VERBARG_SEEN;
     if (RExC_seen & REG_SEEN_CUTGROUP)
 	r->intflags |= PREGf_CUTGROUP_SEEN;
+    if (pm_flags & PMf_USE_RE_EVAL)
+	r->intflags |= PREGf_USE_RE_EVAL;
     if (RExC_paren_names)
         RXp_PAREN_NAMES(r) = MUTABLE_HV(SvREFCNT_inc(RExC_paren_names));
     else
diff --git a/regcomp.h b/regcomp.h
index cca15bcd51..89db7ccd32 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -137,6 +137,7 @@
 #define PREGf_NAUGHTY		0x00000004 /* how exponential is this pattern? */
 #define PREGf_VERBARG_SEEN	0x00000008
 #define PREGf_CUTGROUP_SEEN	0x00000010
+#define PREGf_USE_RE_EVAL	0x00000020 /* compiled with "use re 'eval'" */
 
 
 /* this is where the old regcomp.h started */
diff --git a/regexec.c b/regexec.c
index 2d86b0e41e..3e9cf21407 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4483,7 +4483,15 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 			    const char *const p = SvPV(ret, len);
 			    ret = newSVpvn_flags(p, len, SVs_TEMP);
 			}
-			rx = CALLREGCOMP(ret, pm_flags);
+			if (rex->intflags & PREGf_USE_RE_EVAL)
+			    pm_flags |= PMf_USE_RE_EVAL;
+
+			/* if we got here, it should be an engine which
+			 * supports compiling code blocks and stuff */
+			assert(rex->engine && rex->engine->op_comp);
+			rx = rex->engine->op_comp(aTHX_ &ret, 1, NULL,
+				    rex->engine, NULL, NULL, 0, pm_flags);
+
 			if (!(SvFLAGS(ret)
 			      & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
 				 | SVs_GMG))) {
diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index 338f5c2be0..0c16f9e20a 100644
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 }
 
 
-plan tests => 444;  # Update this when adding/deleting tests.
+plan tests => 446;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -933,6 +933,19 @@ sub run_tests {
 	    'syntax error');
     }
 
+    # make sure that 'use re eval' is propagated into compiling the
+    # pattern returned by (??{})
+
+    {
+	use re 'eval';
+	my $pat = 'B(??{1})C';
+	my $A = 'A';
+	# compile-time outer code-block
+	ok("AB1CD" =~ /^A(??{$pat})D$/, "re eval propagated compile-time");
+	# run-time outer code-block
+	ok("AB1CD" =~ /^$A(??{$pat})D$/, "re eval propagated run-time");
+    }
+
 
 } # End of sub run_tests