Merge re_eval jumbo fix branch into blead

This re_eval branch contains around 130 commits that collectively
reimplement the /(?{})/ mechanism. See the individual commits
and the changes to pod/* for more details, but the main highlights are:

=item *

Code blocks within patterns are now parsed in the same pass as the
surrounding code; in particular it is no longer necessary to have balanced
braces: this now works:

    /(?{  $x='{'  })/

This means that this error message is longer generated:

    Sequence (?{...}) not terminated or not {}-balanced in regex

but a new error may be seen:

    Sequence (?{...}) not terminated with ')'

In addition, literal code blocks within run-time patterns are only
compiled once, at perl compile-time:

    for my $p (...) {
        # this 'FOO' block of code is compiled once, at the same time as
        # the surrounding 'for' loop
        /$p{(?{FOO;})/;
    }

=item *

Lexical variables are now sane as regards scope, recursion and closure
behaviour. In particular, C</A(?{B})C/> behaves (from a closure viewpoint)
exactly like C</A/ && do { B } && /C/>, while  C<qr/A(?{B})C/> is like
C<sub {/A/ && do { B } && /C/}>. So this code now works how you might
expect, creating three regexes that match 1,2, and 3:

    for my $i (0..2) {
        push @r, qr/^(??{$i})$/;
    }
    "1" =~ $r[1]; # matches

=item *

The C<use re 'eval'> pragma is now strictly only required for code blocks
defined at runtime; in particular in the following, the text of the $r
pattern is still interpolated into the new pattern and recompiled, but
the individual compiled code-blocks within $r are reused rather than being
recompiled, and C<use re 'eval'> isn't needed any more:

    my $r = qr/abc(?{....})def/;
    /xyz$r/;

=item *

Flow control operators no longer crash. Each code block runs in a new
dynamic scope, so C<next> etc. will not see any enclosing loops and
C<caller> will not see any calling subroutines. C<return> returns a value
from the code block, not from any enclosing subroutine.

=item *

Perl normally caches the compilation of run-time patterns, and doesn't
recompile if the pattern hasn't changed; but this is now disabled if
required for the correct behaviour of closures; for example:

    my $code = '(??{$x})';
    for my $x (1..3) {
        $x =~ /$code/; # recompile to see fresh value of $x each time
    }

=item *

C</msix> and C<(?msix)> etc. flags are now propagated into the return
value from C<(??{})>; this now works:

    "AB" =~ /a(??{'b'})/i;

=item *

Warnings and errors will appear to come from the surrounding code (or for
run-time code blocks, from an eval) rather than from an C<re_eval>:

    use re 'eval'; $c = '(?{ warn "foo" })'; /$c/;
    /(?{ warn "foo" })/;

formerly gave:

    foo at (re_eval 1) line 1.
    foo at (re_eval 2) line 1.

and now gives:

    foo at (eval 1) line 1.
    foo at /tmp/foo line 2.

=item *

In the pluggable regex API, the regexp_engine struct has acquired a new
field C<op_comp>, which is currently just for perl's internal use, and
should be initialised to NULL by other regexp plugin modules.

Author: iabyn

MANIFEST

@@ -5393,6 +5393,7 @@ t/re/qr-72922.t			Test for bug #72922
 t/re/qr_gc.t			See if qr doesn't leak
 t/re/qrstack.t			See if qr expands the stack properly
 t/re/qr.t			See if qr works
+t/re/recompile.t		See if pattern caching/recompilation works
 t/re/reg_60508.t		See if bug #60508 is fixed
 t/re/reg_email.t		See if regex recursion works by parsing email addresses
 t/re/reg_email_thr.t		See if regex recursion works by parsing email addresses in another thread

cop.h

@@ -1180,6 +1180,12 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     U8 hasargs = 0		/* used by PUSHSUB */
 
 #define PUSH_MULTICALL(the_cv) \
+    PUSH_MULTICALL_WITHDEPTH(the_cv, 1);
+
+/* Like PUSH_MULTICALL, but allows you to specify the CvDEPTH increment,
+ * rather than the default of 1 (this isn't part of the public API) */
+
+#define PUSH_MULTICALL_WITHDEPTH(the_cv, depth) \
     STMT_START {							\
 	CV * const _nOnclAshIngNamE_ = the_cv;				\
 	CV * const cv = _nOnclAshIngNamE_;				\
@@ -1191,7 +1197,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 	PUSHSTACKi(PERLSI_SORT);					\
 	PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);		\
 	PUSHSUB(cx);							\
-	if (++CvDEPTH(cv) >= 2) {					\
+	CvDEPTH(cv) += depth;						\
+	if (CvDEPTH(cv) >= 2) {						\
 	    PERL_STACK_OVERFLOW_CHECK();				\
 	    Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));			\
 	}								\
@@ -1209,15 +1216,41 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
 #define POP_MULTICALL \
     STMT_START {							\
-	if (! --CvDEPTH(multicall_cv))					\
-	    LEAVESUB(multicall_cv);					\
+	if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {	\
+		LEAVESUB(multicall_cv);					\
+	}								\
 	POPBLOCK(cx,PL_curpm);						\
 	POPSTACK;							\
 	CATCH_SET(multicall_oldcatch);					\
 	LEAVE;								\
 	SPAGAIN;							\
     } STMT_END
 
+/* Change the CV of an already-pushed MULTICALL CxSUB block.
+ * (this isn't part of the public API) */
+
+#define CHANGE_MULTICALL_WITHDEPTH(the_cv, depth) \
+    STMT_START {							\
+	CV * const _nOnclAshIngNamE_ = the_cv;				\
+	CV * const cv = _nOnclAshIngNamE_;				\
+	AV * const padlist = CvPADLIST(cv);				\
+	cx = &cxstack[cxstack_ix];					\
+	assert(cx->cx_type & CXp_MULTICALL);				\
+	if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {	\
+		LEAVESUB(multicall_cv);					\
+	}								\
+	cx->cx_type &= ~CXp_HASARGS;					\
+	PUSHSUB(cx);							\
+	CvDEPTH(cv) += depth;						\
+	if (CvDEPTH(cv) >= 2) {						\
+	    PERL_STACK_OVERFLOW_CHECK();				\
+	    Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));			\
+	}								\
+	SAVECOMPPAD();							\
+	PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));			\
+	multicall_cv = cv;						\
+	multicall_cop = CvSTART(cv);					\
+    } STMT_END
 /*
  * Local variables:
  * c-indentation-style: bsd

dist/B-Deparse/Deparse.pm

@@ -4587,7 +4587,10 @@ sub matchop {
 	carp("found ".$kid->name." where regcomp expected");
     } else {
 	($re, $quote) = $self->regcomp($kid, 21, $extended);
-	my $matchop = $kid->first->first;
+	my $matchop = $kid->first;
+	if ($matchop->name eq 'regcrest') {
+	    $matchop = $matchop->first;
+	}
 	if ($matchop->name =~ /^(?:match|transr?|subst)\z/
 	   && $matchop->flags & OPf_SPECIAL) {
 	    $rhs_bound_to_defsv = 1;

dump.c

@@ -613,6 +613,15 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
 	Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
 	op_dump(pm->op_pmreplrootu.op_pmreplroot);
     }
+    if (pm->op_code_list) {
+	if (pm->op_pmflags & PMf_CODELIST_PRIVATE) {
+	    Perl_dump_indent(aTHX_ level, file, "CODE_LIST =\n");
+	    do_op_dump(level, file, pm->op_code_list);
+	}
+	else
+	    Perl_dump_indent(aTHX_ level, file, "CODE_LIST = 0x%"UVxf"\n",
+				    PTR2UV(pm->op_code_list));
+    }
     if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) {
 	SV * const tmpsv = pm_description(pm);
 	Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
@@ -630,6 +639,9 @@ const struct flag_to_name pmflags_flags_names[] = {
     {PMf_RETAINT, ",RETAINT"},
     {PMf_EVAL, ",EVAL"},
     {PMf_NONDESTRUCT, ",NONDESTRUCT"},
+    {PMf_HAS_CV, ",HAS_CV"},
+    {PMf_CODELIST_PRIVATE, ",CODELIST_PRIVATE"},
+    {PMf_IS_QR, ",IS_QR"}
 };
 
 static SV *
@@ -2040,8 +2052,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 				(UV)(r->gofs));
 	    Perl_dump_indent(aTHX_ level, file, "  PRE_PREFIX = %"UVuf"\n",
 				(UV)(r->pre_prefix));
-	    Perl_dump_indent(aTHX_ level, file, "  SEEN_EVALS = %"UVuf"\n",
-				(UV)(r->seen_evals));
 	    Perl_dump_indent(aTHX_ level, file, "  SUBLEN = %"IVdf"\n",
 				(IV)(r->sublen));
 	    if (r->subbeg)
@@ -2062,6 +2072,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 				PTR2UV(r->pprivate));
 	    Perl_dump_indent(aTHX_ level, file, "  OFFS = 0x%"UVxf"\n",
 				PTR2UV(r->offs));
+	    Perl_dump_indent(aTHX_ level, file, "  QR_ANONCV = 0x%"UVxf"\n",
+				PTR2UV(r->qr_anoncv));
 #ifdef PERL_OLD_COPY_ON_WRITE
 	    Perl_dump_indent(aTHX_ level, file, "  SAVED_COPY = 0x%"UVxf"\n",
 				PTR2UV(r->saved_copy));

embed.fnc

@@ -1024,7 +1024,7 @@ Apd	|void	|packlist 	|NN SV *cat|NN const char *pat|NN const char *patend|NN SV
 s	|void	|pidgone	|Pid_t pid|int status
 #endif
 : Used in perly.y
-p	|OP*	|pmruntime	|NN OP *o|NN OP *expr|bool isreg
+p	|OP*	|pmruntime	|NN OP *o|NN OP *expr|bool isreg|I32 floor
 #if defined(PERL_IN_OP_C)
 s	|OP*	|pmtrans	|NN OP* o|NN OP* expr|NN OP* repl
 #endif
@@ -1056,8 +1056,15 @@ Ap	|void	|regfree_internal|NN REGEXP *const rx
 #if defined(USE_ITHREADS)
 Ap	|void*	|regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param
 #endif
+EXp	|regexp_engine const *|current_re_engine
 Ap	|REGEXP*|pregcomp	|NN SV * const pattern|const U32 flags
-Ap	|REGEXP*|re_compile	|NN SV * const pattern|U32 flags
+p	|REGEXP*|re_op_compile	|NULLOK SV ** const patternp \
+				|int pat_count|NULLOK OP *expr \
+				|NN const regexp_engine* eng \
+				|NULLOK REGEXP *VOL old_re \
+				|NULLOK bool *is_bare_re \
+				|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 \
 				|NULLOK re_scream_pos_data *data
@@ -1267,13 +1274,6 @@ Apd	|I32	|sv_cmp_locale_flags	|NULLOK SV *const sv1 \
 Amd	|char*	|sv_collxfrm	|NN SV *const sv|NN STRLEN *const nxp
 Apd	|char*	|sv_collxfrm_flags	|NN SV *const sv|NN STRLEN *const nxp|I32 const flags
 #endif
-: Frustratingly, because regcomp.c is also compiled as ext/re/re_comp.c,
-: anything it needs has to be exported. So this has to be X. I'd rather it
-: wasn't.
-Xpo	|OP*	|sv_compile_2op_is_broken|NN SV *sv|NN OP **startop \
-				|NN const char *code|NN PAD **padp
-ApD	|OP*	|sv_compile_2op	|NN SV *sv|NN OP **startop \
-				|NN const char *code|NN PAD **padp
 Apd	|int	|getcwd_sv	|NN SV* sv
 Apd	|void	|sv_dec		|NULLOK SV *const sv
 Apd	|void	|sv_dec_nomg	|NULLOK SV *const sv
@@ -1859,7 +1859,7 @@ sR	|I32	|dopoptoloop	|I32 startingblock
 sR	|I32	|dopoptosub_at	|NN const PERL_CONTEXT* cxstk|I32 startingblock
 sR	|I32	|dopoptowhen	|I32 startingblock
 s	|void	|save_lines	|NULLOK AV *array|NN SV *sv
-s	|bool	|doeval		|int gimme|NULLOK OP** startop \
+s	|bool	|doeval		|int gimme \
 				|NULLOK CV* outside|U32 seq|NULLOK HV* hh
 sR	|PerlIO *|check_type_and_open|NN SV *name
 #ifndef PERL_DISABLE_PMC
@@ -1996,8 +1996,8 @@ ERs	|I32	|regrepeat	|NN const regexp *prog|NN const regnode *p|I32 max|int depth
 ERs	|I32	|regtry		|NN regmatch_info *reginfo|NN char **startpos
 ERs	|bool	|reginclass	|NULLOK const regexp * const prog|NN const regnode * const n|NN const U8 * const p|NULLOK STRLEN *lenp\
 				|bool const do_utf8sv_is_utf8
-Es	|CHECKPOINT|regcppush	|I32 parenfloor
-Es	|char*	|regcppop	|NN const regexp *rex
+Es	|CHECKPOINT|regcppush	|NN const regexp *rex|I32 parenfloor
+Es	|void	|regcppop	|NN regexp *rex
 ERsn	|U8*	|reghop3	|NN U8 *s|I32 off|NN const U8 *lim
 ERsM	|SV*	|core_regclass_swash|NULLOK const regexp *prog \
 				|NN const struct regnode *node|bool doinit \
@@ -2114,7 +2114,8 @@ s	|char*	|scan_ident	|NN char *s|NN const char *send|NN char *dest \
 				|STRLEN destlen|I32 ck_uni
 sR	|char*	|scan_inputsymbol|NN char *start
 sR	|char*	|scan_pat	|NN char *start|I32 type
-sR	|char*	|scan_str	|NN char *start|int keep_quoted|int keep_delims
+sR	|char*	|scan_str	|NN char *start|int keep_quoted \
+				|int keep_delims|int re_reparse
 sR	|char*	|scan_subst	|NN char *start
 sR	|char*	|scan_trans	|NN char *start
 s	|char*	|scan_word	|NN char *s|NN char *dest|STRLEN destlen \

embed.h

@@ -558,7 +558,6 @@
 #define sv_clear(a)		Perl_sv_clear(aTHX_ a)
 #define sv_cmp_flags(a,b,c)	Perl_sv_cmp_flags(aTHX_ a,b,c)
 #define sv_cmp_locale_flags(a,b,c)	Perl_sv_cmp_locale_flags(aTHX_ a,b,c)
-#define sv_compile_2op(a,b,c,d)	Perl_sv_compile_2op(aTHX_ a,b,c,d)
 #define sv_copypv(a,b)		Perl_sv_copypv(aTHX_ a,b)
 #define sv_dec(a)		Perl_sv_dec(aTHX_ a)
 #define sv_dec_nomg(a)		Perl_sv_dec_nomg(aTHX_ a)
@@ -857,6 +856,7 @@
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define _is_utf8__perl_idstart(a)	Perl__is_utf8__perl_idstart(aTHX_ a)
 #define av_reify(a)		Perl_av_reify(aTHX_ a)
+#define current_re_engine()	Perl_current_re_engine(aTHX)
 #define is_utf8_X_L(a)		Perl_is_utf8_X_L(aTHX_ a)
 #define is_utf8_X_LV(a)		Perl_is_utf8_X_LV(aTHX_ a)
 #define is_utf8_X_LVT(a)	Perl_is_utf8_X_LVT(aTHX_ a)
@@ -972,7 +972,7 @@
 #define find_byclass(a,b,c,d,e)	S_find_byclass(aTHX_ a,b,c,d,e)
 #define reg_check_named_buff_matched(a,b)	S_reg_check_named_buff_matched(aTHX_ a,b)
 #define regcppop(a)		S_regcppop(aTHX_ a)
-#define regcppush(a)		S_regcppush(aTHX_ a)
+#define regcppush(a,b)		S_regcppush(aTHX_ a,b)
 #define reghop3			S_reghop3
 #define reghopmaybe3		S_reghopmaybe3
 #define reginclass(a,b,c,d,e)	S_reginclass(aTHX_ a,b,c,d,e)
@@ -1173,7 +1173,8 @@
 #define parse_unicode_opts(a)	Perl_parse_unicode_opts(aTHX_ a)
 #define parser_free(a)		Perl_parser_free(aTHX_ a)
 #define peep(a)			Perl_peep(aTHX_ a)
-#define pmruntime(a,b,c)	Perl_pmruntime(aTHX_ a,b,c)
+#define pmruntime(a,b,c,d)	Perl_pmruntime(aTHX_ a,b,c,d)
+#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)
@@ -1464,7 +1465,7 @@
 #define destroy_matcher(a)	S_destroy_matcher(aTHX_ a)
 #define do_smartmatch(a,b,c)	S_do_smartmatch(aTHX_ a,b,c)
 #define docatch(a)		S_docatch(aTHX_ a)
-#define doeval(a,b,c,d,e)	S_doeval(aTHX_ a,b,c,d,e)
+#define doeval(a,b,c,d)		S_doeval(aTHX_ a,b,c,d)
 #define dofindlabel(a,b,c,d,e,f)	S_dofindlabel(aTHX_ a,b,c,d,e,f)
 #define doparseform(a)		S_doparseform(aTHX_ a)
 #define dopoptoeval(a)		S_dopoptoeval(aTHX_ a)
@@ -1584,7 +1585,7 @@
 #define scan_ident(a,b,c,d,e)	S_scan_ident(aTHX_ a,b,c,d,e)
 #define scan_inputsymbol(a)	S_scan_inputsymbol(aTHX_ a)
 #define scan_pat(a,b)		S_scan_pat(aTHX_ a,b)
-#define scan_str(a,b,c)		S_scan_str(aTHX_ a,b,c)
+#define scan_str(a,b,c,d)	S_scan_str(aTHX_ a,b,c,d)
 #define scan_subst(a)		S_scan_subst(aTHX_ a)
 #define scan_trans(a)		S_scan_trans(aTHX_ a)
 #define scan_word(a,b,c,d,e)	S_scan_word(aTHX_ a,b,c,d,e)

embedvar.h

@@ -277,7 +277,6 @@
 #define PL_regdummy		(vTHX->Iregdummy)
 #define PL_regex_pad		(vTHX->Iregex_pad)
 #define PL_regex_padav		(vTHX->Iregex_padav)
-#define PL_reginterp_cnt	(vTHX->Ireginterp_cnt)
 #define PL_registered_mros	(vTHX->Iregistered_mros)
 #define PL_regmatch_slab	(vTHX->Iregmatch_slab)
 #define PL_regmatch_state	(vTHX->Iregmatch_state)

ext/B/B.pm

@@ -1163,6 +1163,10 @@ Since Perl 5.9.5
 
 Only when perl was compiled with ithreads.
 
+=item code_list
+
+Since perl 5.17.1
+
 =back
 
 =head2 B::SVOP METHOD

ext/B/B.xs

@@ -864,6 +864,7 @@ threadsv_names()
 #define OP_private_ix		U8p | offsetof(struct op, op_private)
 
 #define PMOP_pmflags_ix		U32p | offsetof(struct pmop, op_pmflags)
+#define PMOP_code_list_ix	OPp | offsetof(struct pmop, op_code_list)
 
 #ifdef USE_ITHREADS
 #define PMOP_pmoffset_ix	IVp | offsetof(struct pmop, op_pmoffset)
@@ -922,6 +923,7 @@ next(o)
 	B::LOOP::nextop = LOOP_nextop_ix
 	B::LOOP::lastop = LOOP_lastop_ix
 	B::PMOP::pmflags = PMOP_pmflags_ix
+	B::PMOP::code_list = PMOP_code_list_ix
 	B::SVOP::sv = SVOP_sv_ix
 	B::SVOP::gv = SVOP_gv_ix
 	B::PADOP::padix = PADOP_padix_ix

ext/Devel-Peek/t/Peek.t

@@ -349,15 +349,15 @@ do_test('reference to regexp',
     MINLENRET = 3
     GOFS = 0
     PRE_PREFIX = 4
-    SEEN_EVALS = 0
     SUBLEN = 0
     SUBBEG = 0x0
     ENGINE = $ADDR
     MOTHER_RE = $ADDR
     PAREN_NAMES = 0x0
     SUBSTRS = $ADDR
     PPRIVATE = $ADDR
-    OFFS = $ADDR'
+    OFFS = $ADDR
+    QR_ANONCV = 0x0'
 ));
 } else {
 do_test('reference to regexp',

ext/re/re.pm

@@ -4,7 +4,7 @@ package re;
 use strict;
 use warnings;
 
-our $VERSION     = "0.19";
+our $VERSION     = "0.20";
 our @ISA         = qw(Exporter);
 our @EXPORT_OK   = ('regmust',
                     qw(is_regexp regexp_pattern
@@ -284,8 +284,9 @@ other transformations.
 
 When C<use re 'eval'> is in effect, a regexp is allowed to contain
 C<(?{ ... })> zero-width assertions and C<(??{ ... })> postponed
-subexpressions, even if the regular expression contains
-variable interpolation.  That is normally disallowed, since it is a
+subexpressions that are derived from variable interpolation, rather than
+appearing literally within the regexp.  That is normally disallowed, since
+it is a
 potential security risk.  Note that this pragma is ignored when the regular
 expression is obtained from tainted data, i.e.  evaluation is always
 disallowed with tainted regular expressions.  See L<perlre/(?{ code })> 

ext/re/re.xs

@@ -12,6 +12,10 @@
 START_EXTERN_C
 
 extern REGEXP*	my_re_compile (pTHX_ SV * const pattern, const U32 pm_flags);
+extern REGEXP*	my_re_op_compile (pTHX_ SV ** const patternp, int pat_count,
+		    OP *expr, const regexp_engine* eng, REGEXP *VOL old_re,
+		     bool *is_bare_re, U32 rx_flags, U32 pm_flags);
+
 extern I32	my_regexec (pTHX_ REGEXP * const prog, char* stringarg, char* strend,
 			    char* strbeg, I32 minend, SV* screamer,
 			    void* data, U32 flags);
@@ -57,8 +61,9 @@ const struct regexp_engine my_reg_engine = {
         my_reg_named_buff_iter,
         my_reg_qr_package,
 #if defined(USE_ITHREADS)
-        my_regdupe 
+        my_regdupe,
 #endif
+        my_re_op_compile,
 };
 
 MODULE = re	PACKAGE = re

ext/re/re_top.h

@@ -13,6 +13,7 @@
 #define Perl_regprop            my_regprop
 #define Perl_re_intuit_start    my_re_intuit_start
 #define Perl_re_compile         my_re_compile
+#define Perl_re_op_compile      my_re_op_compile
 #define Perl_regfree_internal   my_regfree
 #define Perl_re_intuit_string   my_re_intuit_string
 #define Perl_regdupe_internal   my_regdupe

ext/re/t/reflags.t

@@ -10,26 +10,35 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 53;
+use Test::More tests => 62;
 
 my @flags = qw( a d l u );
 
 use re '/i';
 ok "Foo" =~ /foo/, 'use re "/i"';
+ok "Foo" =~ /(??{'foo'})/, 'use re "/i" (??{})';
 no re '/i';
 ok "Foo" !~ /foo/, 'no re "/i"';
+ok "Foo" !~ /(??{'foo'})/, 'no re "/i" (??{})';
 use re '/x';
 ok "foo" =~ / foo /, 'use re "/x"';
+ok "foo" =~ / (??{' foo '}) /, 'use re "/x" (??{})';
 no re '/x';
 ok "foo" !~ / foo /, 'no re "/x"';
+ok "foo" !~ /(??{' foo '})/, 'no re "/x" (??{})';
+ok "foo" !~ / (??{'foo'}) /, 'no re "/x" (??{})';
 use re '/s';
 ok "\n" =~ /./, 'use re "/s"';
+ok "\n" =~ /(??{'.'})/, 'use re "/s" (??{})';
 no re '/s';
 ok "\n" !~ /./, 'no re "/s"';
+ok "\n" !~ /(??{'.'})/, 'no re "/s" (??{})';
 use re '/m';
 ok "\nfoo" =~ /^foo/, 'use re "/m"';
+ok "\nfoo" =~ /(??{'^'})foo/, 'use re "/m" (??{})';
 no re '/m';
 ok "\nfoo" !~ /^foo/, 'no re "/m"';
+ok "\nfoo" !~ /(??{'^'})foo/, 'no re "/m" (??{})';
 
 use re '/xism';
 ok qr// =~ /(?=.*x)(?=.*i)(?=.*s)(?=.*m)/, 'use re "/multiple"';