summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2012-05-31 11:46:23 +0100
committerDavid Mitchell <davem@iabyn.com>2012-06-13 13:32:54 +0100
commit732caac7f4933bbaa60046b5567f5823c06d15b5 (patch)
treee8e4f0647afcf8c66ff4f23ec93a8f5fccd910c2
parent74088413856f71406615c6b1ae959e57f51d192a (diff)
downloadperl-732caac7f4933bbaa60046b5567f5823c06d15b5.tar.gz
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.
-rw-r--r--op.c5
-rw-r--r--regcomp.c2
-rw-r--r--regcomp.h1
-rw-r--r--regexec.c10
-rw-r--r--t/re/pat_re_eval.t15
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