This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Create wrapper fcn for re_op_compile
authorKarl Williamson <khw@cpan.org>
Thu, 13 Feb 2020 03:53:20 +0000 (20:53 -0700)
committerKarl Williamson <khw@cpan.org>
Thu, 20 Feb 2020 05:09:48 +0000 (22:09 -0700)
This does the bulk of re_compile(), but is a private entry point,
meaning it takes an extra parameter, and a future commit will call it
from another place.

embed.fnc
embed.h
proto.h
regcomp.c

index 51c15e8..0cb88ab 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1913,6 +1913,7 @@ EiRT      |bool   |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
 EiT    |void   |invlist_iterfinish|NN SV* invlist
 #endif
 #if defined(PERL_IN_REGCOMP_C)
+ERS    |REGEXP*|re_op_compile_wrapper|NN SV * const pattern|U32 orig_rx_flags|const U32 pm_flags
 EiRT   |bool   |invlist_is_iterating|NN SV* const invlist
 EiR    |SV*    |invlist_contents|NN SV* const invlist              \
                                 |const bool traditional_style
diff --git a/embed.h b/embed.h
index 8152b16..a6cd2b2 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define parse_lparen_question_flags(a) S_parse_lparen_question_flags(aTHX_ a)
 #define parse_uniprop_string(a,b,c,d,e,f,g,h,i)        Perl_parse_uniprop_string(aTHX_ a,b,c,d,e,f,g,h,i)
 #define populate_ANYOF_from_invlist(a,b)       S_populate_ANYOF_from_invlist(aTHX_ a,b)
+#define re_op_compile_wrapper(a,b,c)   S_re_op_compile_wrapper(aTHX_ a,b,c)
 #define reg(a,b,c,d)           S_reg(aTHX_ a,b,c,d)
 #define reg2Lanode(a,b,c,d)    S_reg2Lanode(aTHX_ a,b,c,d)
 #define reg_node(a,b)          S_reg_node(aTHX_ a,b)
diff --git a/proto.h b/proto.h
index de52524..cb314c2 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5683,6 +5683,11 @@ PERL_STATIC_NO_RET void  S_re_croak2(pTHX_ bool utf8, const char* pat1, const cha
 #define PERL_ARGS_ASSERT_RE_CROAK2     \
        assert(pat1); assert(pat2)
 
+STATIC REGEXP* S_re_op_compile_wrapper(pTHX_ SV * const pattern, U32 orig_rx_flags, const U32 pm_flags)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_RE_OP_COMPILE_WRAPPER \
+       assert(pattern)
+
 STATIC regnode_offset  S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth);
 #define PERL_ARGS_ASSERT_REG   \
        assert(pRExC_state); assert(flagp)
index caed27a..fa23d38 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6626,15 +6626,24 @@ Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags)
 REGEXP *
 Perl_re_compile(pTHX_ SV * const pattern, U32 rx_flags)
 {
-    SV *pat = pattern; /* defeat constness! */
     PERL_ARGS_ASSERT_RE_COMPILE;
+    return re_op_compile_wrapper(pattern, rx_flags, 0);
+}
+
+REGEXP *
+S_re_op_compile_wrapper(pTHX_ SV * const pattern, U32 rx_flags, const U32 pm_flags)
+{
+    SV *pat = pattern; /* defeat constness! */
+
+    PERL_ARGS_ASSERT_RE_OP_COMPILE_WRAPPER;
+
     return Perl_re_op_compile(aTHX_ &pat, 1, NULL,
 #ifdef PERL_IN_XSUB_RE
                                 &my_reg_engine,
 #else
                                 &PL_core_reg_engine,
 #endif
-                                NULL, NULL, rx_flags, 0);
+                                NULL, NULL, rx_flags, pm_flags);
 }