This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow debugging from regexec.c back to regcomp.c
authorKarl Williamson <khw@cpan.org>
Tue, 25 Feb 2020 05:25:07 +0000 (22:25 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 11 Mar 2020 22:09:43 +0000 (16:09 -0600)
The compilation of User-defined properties in a regular expression that
haven't been defined at the time that pattern is compiled is deferred
until execution time.  Until this commit, any request for debugging info
on those was ignored.

This fixes that by

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

index f32d97c..8a8de89 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2201,13 +2201,23 @@ EiRT    |bool   |_invlist_contains_cp|NN SV* const invlist|const UV cp
 EXpRT  |SSize_t|_invlist_search        |NN SV* const invlist|const UV cp
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
-EXp    |SV*    |_get_regclass_nonbitmap_data                              \
+#  ifndef PERL_EXT_RE_BUILD
+Ep     |SV*    |get_regclass_nonbitmap_data                               \
                                |NULLOK const regexp *prog                 \
                                |NN const struct regnode *node             \
                                |bool doinit                               \
                                |NULLOK SV **listsvp                       \
                                |NULLOK SV **lonly_utf8_locale             \
                                |NULLOK SV **output_invlist
+#  else
+Ep     |SV*    |get_re_gclass_nonbitmap_data                              \
+                               |NULLOK const regexp *prog                 \
+                               |NN const struct regnode *node             \
+                               |bool doinit                               \
+                               |NULLOK SV **listsvp                       \
+                               |NULLOK SV **lonly_utf8_locale             \
+                               |NULLOK SV **output_invlist
+#endif
 Ep     |void   |regprop        |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o|NULLOK const regmatch_info *reginfo \
                                |NULLOK const RExC_state_t *pRExC_state
 Efp    |int    |re_printf      |NN const char *fmt|...
diff --git a/embed.h b/embed.h
index 0643098..fb3fca2 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  if ! defined(HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT))
 #define my_memrchr             S_my_memrchr
 #  endif
+#  if !(!defined(PERL_EXT_RE_BUILD))
+#    if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
+#define get_re_gclass_nonbitmap_data(a,b,c,d,e,f)      Perl_get_re_gclass_nonbitmap_data(aTHX_ a,b,c,d,e,f)
+#    endif
+#  endif
 #  if !defined(PERL_EXT_RE_BUILD)
 #    if defined(PERL_IN_REGCOMP_C)
 #define _append_range_to_invlist(a,b,c)        S__append_range_to_invlist(aTHX_ a,b,c)
 #define invlist_set_previous_index     S_invlist_set_previous_index
 #define invlist_trim           S_invlist_trim
 #    endif
+#    if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
+#define get_regclass_nonbitmap_data(a,b,c,d,e,f)       Perl_get_regclass_nonbitmap_data(aTHX_ a,b,c,d,e,f)
+#    endif
 #  endif
 #  if defined(DEBUGGING)
 #    if defined(PERL_IN_REGCOMP_C)
 #define get_regex_charset_name S_get_regex_charset_name
 #  endif
 #  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
-#define _get_regclass_nonbitmap_data(a,b,c,d,e,f)      Perl__get_regclass_nonbitmap_data(aTHX_ a,b,c,d,e,f)
 #ifndef PERL_IMPLICIT_CONTEXT
 #define re_printf              Perl_re_printf
 #endif
diff --git a/proto.h b/proto.h
index 6bbbe2a..1a63b4f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4143,6 +4143,13 @@ PERL_STATIC_INLINE void *        S_my_memrchr(const char * s, const char c, const STRLE
        assert(s)
 #endif
 #endif
+#if !(!defined(PERL_EXT_RE_BUILD))
+#  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
+PERL_CALLCONV SV*      Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const struct regnode *node, bool doinit, SV **listsvp, SV **lonly_utf8_locale, SV **output_invlist);
+#define PERL_ARGS_ASSERT_GET_RE_GCLASS_NONBITMAP_DATA  \
+       assert(node)
+#  endif
+#endif
 #if !(defined(DEBUGGING))
 #  if !defined(NV_PRESERVES_UV)
 #    if defined(PERL_IN_SV_C)
@@ -4325,6 +4332,11 @@ PERL_STATIC_INLINE void  S_invlist_trim(SV* invlist);
        assert(invlist)
 #endif
 #  endif
+#  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
+PERL_CALLCONV SV*      Perl_get_regclass_nonbitmap_data(pTHX_ const regexp *prog, const struct regnode *node, bool doinit, SV **listsvp, SV **lonly_utf8_locale, SV **output_invlist);
+#define PERL_ARGS_ASSERT_GET_REGCLASS_NONBITMAP_DATA   \
+       assert(node)
+#  endif
 #endif
 #if !defined(PERL_IMPLICIT_SYS)
 PERL_CALLCONV I32      Perl_my_pclose(pTHX_ PerlIO* ptr);
@@ -6054,9 +6066,6 @@ PERL_STATIC_INLINE const char *   S_get_regex_charset_name(const U32 flags, STRLEN
 #endif
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C)
-PERL_CALLCONV SV*      Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog, const struct regnode *node, bool doinit, SV **listsvp, SV **lonly_utf8_locale, SV **output_invlist);
-#define PERL_ARGS_ASSERT__GET_REGCLASS_NONBITMAP_DATA  \
-       assert(node)
 PERL_CALLCONV int      Perl_re_printf(pTHX_ const char *fmt, ...)
                        __attribute__format__(__printf__,pTHX_1,pTHX_2);
 #define PERL_ARGS_ASSERT_RE_PRINTF     \
index 118085c..93624f3 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -19908,14 +19908,13 @@ S_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state,
     }
 }
 
-#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
 SV *
-Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog,
-                                        const regnode* node,
-                                        bool doinit,
-                                        SV** listsvp,
-                                        SV** only_utf8_locale_ptr,
-                                        SV** output_invlist)
+
+#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
+Perl_get_regclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, bool doinit, SV** listsvp, SV** only_utf8_locale_ptr, SV** output_invlist)
+#else
+Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, bool doinit, SV** listsvp, SV** only_utf8_locale_ptr, SV** output_invlist)
+#endif
 
 {
     /* For internal core use only.
@@ -19951,7 +19950,11 @@ Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog,
     RXi_GET_DECL(prog, progi);
     const struct reg_data * const data = prog ? progi->data : NULL;
 
-    PERL_ARGS_ASSERT__GET_REGCLASS_NONBITMAP_DATA;
+#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
+    PERL_ARGS_ASSERT_GET_REGCLASS_NONBITMAP_DATA;
+#else
+    PERL_ARGS_ASSERT_GET_RE_GCLASS_NONBITMAP_DATA;
+#endif
     assert(! output_invlist || listsvp);
 
     if (data && data->count) {
@@ -20154,7 +20157,6 @@ Perl__get_regclass_nonbitmap_data(pTHX_ const regexp *prog,
 
     return invlist;
 }
-#endif /* !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION) */
 
 /* reg_skipcomment()
 
@@ -21166,10 +21168,17 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_
                                             ANYOFRbase(o) + ANYOFRdelta(o));
             }
             else {
-                (void) _get_regclass_nonbitmap_data(prog, o, FALSE,
+#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
+                (void) get_regclass_nonbitmap_data(prog, o, FALSE,
                                                 &unresolved,
                                                 &only_utf8_locale_invlist,
                                                 &nonbitmap_invlist);
+#else
+                (void) get_re_gclass_nonbitmap_data(prog, o, FALSE,
+                                                &unresolved,
+                                                &only_utf8_locale_invlist,
+                                                &nonbitmap_invlist);
+#endif
             }
 
             /* The non-bitmap data may contain stuff that could fit in the
index ee961e7..925a048 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -10244,8 +10244,14 @@ S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const
                          && IN_UTF8_CTYPE_LOCALE)))
         {
             SV* only_utf8_locale = NULL;
-           SV * const definition = _get_regclass_nonbitmap_data(prog, n, TRUE,
-                                                   0, &only_utf8_locale, NULL);
+           SV * const definition =
+#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
+                get_regclass_nonbitmap_data(prog, n, TRUE, 0,
+                                            &only_utf8_locale, NULL);
+#else
+                get_re_gclass_nonbitmap_data(prog, n, TRUE, 0,
+                                             &only_utf8_locale, NULL);
+#endif
            if (definition) {
                 U8 utf8_buffer[2];
                U8 * utf8_p;