#if defined(USE_ITHREADS)
Ap |void* |regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param
#endif
+p |regexp_engine*|current_re_engine
Ap |REGEXP*|pregcomp |NN SV * const pattern|const U32 flags
Ap |REGEXP*|re_compile |NN SV * const pattern|U32 flags
Ap |char* |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \
#define core_prototype(a,b,c,d) Perl_core_prototype(aTHX_ a,b,c,d)
#define coresub_op(a,b,c) Perl_coresub_op(aTHX_ a,b,c)
#define create_eval_scope(a) Perl_create_eval_scope(aTHX_ a)
+#define current_re_engine() Perl_current_re_engine(aTHX)
#define cv_ckproto_len_flags(a,b,c,d,e) Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e)
#define cvgv_set(a,b) Perl_cvgv_set(aTHX_ a,b)
#define cvstash_set(a,b) Perl_cvstash_set(aTHX_ a,b)
if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != len ||
memNE(RX_PRECOMP(re), t, len))
{
- const regexp_engine *eng = re ? RX_ENGINE(re) : NULL;
+ const regexp_engine *eng;
U32 pm_flags = pm->op_pmflags & RXf_PMf_COMPILETIME;
+
if (re) {
+ eng = RX_ENGINE(re);
ReREFCNT_dec(re);
#ifdef USE_ITHREADS
PM_SETRE(pm, (REGEXP*) &PL_sv_undef);
#else
PM_SETRE(pm, NULL); /* crucial if regcomp aborts */
#endif
- } else if (PL_curcop->cop_hints_hash) {
- SV *ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0);
- if (ptr && SvIOK(ptr) && SvIV(ptr))
- eng = INT2PTR(regexp_engine*,SvIV(ptr));
}
+ else
+ eng = current_re_engine();
if (PL_op->op_flags & OPf_SPECIAL)
PL_reginterp_cnt = I32_MAX; /* Mark as safe. */
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE \
assert(cv); assert(params)
+PERL_CALLCONV regexp_engine* Perl_current_re_engine(pTHX);
PERL_CALLCONV const char * Perl_custom_op_desc(pTHX_ const OP *o)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#endif
#ifndef PERL_IN_XSUB_RE
+
+/* return the currently in-scope regex engine (or NULL if none) */
+
+regexp_engine *
+Perl_current_re_engine(pTHX)
+{
+ dVAR;
+
+ if (IN_PERL_COMPILETIME) {
+ HV * const table = GvHV(PL_hintgv);
+ SV **ptr;
+
+ if (!table)
+ return NULL;
+ ptr = hv_fetchs(table, "regcomp", FALSE);
+ if ( !(ptr && SvIOK(*ptr) && SvIV(*ptr)))
+ return NULL;
+ return INT2PTR(regexp_engine*,SvIV(*ptr));
+ }
+ else {
+ SV *ptr;
+ if (!PL_curcop->cop_hints_hash)
+ return NULL;
+ ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0);
+ if ( !(ptr && SvIOK(ptr) && SvIV(ptr)))
+ return NULL;
+ return INT2PTR(regexp_engine*,SvIV(ptr));
+ }
+}
+
+
REGEXP *
Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags)
{
dVAR;
- HV * const table = GvHV(PL_hintgv);
+ regexp_engine *eng = current_re_engine();
PERL_ARGS_ASSERT_PREGCOMP;
- /* Dispatch a request to compile a regexp to correct
- regexp engine. */
- if (table) {
- SV **ptr= hv_fetchs(table, "regcomp", FALSE);
+ /* Dispatch a request to compile a regexp to correct regexp engine. */
+ if (eng) {
GET_RE_DEBUG_FLAGS_DECL;
- if (ptr && SvIOK(*ptr) && SvIV(*ptr)) {
- const regexp_engine *eng=INT2PTR(regexp_engine*,SvIV(*ptr));
- DEBUG_COMPILE_r({
- PerlIO_printf(Perl_debug_log, "Using engine %"UVxf"\n",
- SvIV(*ptr));
- });
- return CALLREGCOMP_ENG(eng, pattern, flags);
- }
+ DEBUG_COMPILE_r({
+ PerlIO_printf(Perl_debug_log, "Using engine %"UVxf"\n",
+ PTR2UV(eng));
+ });
+ return CALLREGCOMP_ENG(eng, pattern, flags);
}
return Perl_re_compile(aTHX_ pattern, flags);
}