From ba6e2c38aafc23cf114f3ba0d0ff3baead34328b Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 1 Aug 2023 23:12:46 +0200
Subject: [PATCH] regcomp*.c, regexec.c - fixup regex engine build under
 -Uusedl

The regex engine is built a bit different from most of the perl
codebase. It is compiled as part of the main libperl.so and it is
also compiled (with DEBUGGING enabled) as part of the re extension.
When perl itself is compiled with DEBUGGING enabled then the code
in the re.so extension and the code in libperl.so is the same.

This all works fine and dandy until you have a static build where the
re.so is linked into libperl.so, which results in duplicate symbols
being defined. These symbols come in two flaviours: "auxiliary" and
"debugging" related symbols.

We have basically three cases:

1. USE_DYNAMIC_LOADING is defined. In this case we are doing a dynamic
   build and re.so will be separate from libperl.so, so it even if this
   is a DEBUGGING enabled build debug and auxiliary functions can be
   compiled into *both* re.so and libperl.so. This is basically the
   "standard build".

2. USE_DYNAMIC_LOADING is not defined, and DEBUGGING is not defined
   either. In this case auxiliary functions should only be compiled in
   libperl.so, and the debug functions should only be compiled into
   re.so

3. USE_DYNAMIC_LOADING is not defined, and DEBUGGING *is* defined. In
   this case auxiliary functions AND debug functions should only be
   compiled into libperl.so

It is possible to detect the different build options by looking at the
defines 'USE_DYNAMIC_LOADING', 'PERL_EXT_RE_DEBUG' and
'DEBUGGING_RE_ONLY'. 'USE_DYNAMIC_LOADING' is NOT defined when we are
building a static perl. 'PERL_EXT_RE_DEBUG' is defined only when we are
building re.so, and 'DEBUGGING_RE_ONLY' is defined only when we are
building re.so in a perl that is not itself already a DEBUGGING enabled
perl. The file ext/re/re_top.h responsible for setting up
DEBUGGING_RE_ONLY.

This patch uses 'PERL_EXT_RE_DEBUG', 'DEBUGGING_RE_ONLY' and
'USE_DYNAMIC_LOADING' to define in regcomp.h two further define flags
'PERL_RE_BUILD_DEBUG' and 'PERL_RE_BUILD_AUX'.

The 'PERL_RE_BUILD_DEBUG' flag determines if the debugging functions
should be compiled into libperl.so or re.so or both. The
'PERL_RE_BUILD_AUX' flag determines if the auxiliary functions should be
compiled into just libperl.so or into it and re.so. We then use these
flags to guard the different types of functions so that we can build in
all three modes without duplicate symbols.

Upstream: https://github.com/Perl/perl5/commit/ba6e2c38aafc23cf114f3ba0d0ff3baead34328b
Signed-off-by: Fabrice Fontaine <fontaine.fabrice@gmail.com>
---
 regcomp.c         |  13 +-
 regcomp.h         |  14 ++-
 regcomp_debug.c   | 308 +++++++++++++++++++++++-----------------------
 regcomp_invlist.c |   3 +-
 regexec.c         |   3 +-
 5 files changed, 181 insertions(+), 160 deletions(-)

diff --git a/regcomp.c b/regcomp.c
index d3c135fbfad1..6e35d95d2ac6 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -290,6 +290,7 @@ S_edit_distance(const UV* src,
 /* END of edit_distance() stuff
  * ========================================================= */
 
+#ifdef PERL_RE_BUILD_AUX
 /* add a data member to the struct reg_data attached to this regex, it should
  * always return a non-zero return. the 's' argument is the type of the items
  * being added and the n is the number of items. The length of 's' should match
@@ -340,6 +341,7 @@ Perl_reg_add_data(RExC_state_t* const pRExC_state, const char* const s, const U3
     assert(count>0);
     return count;
 }
+#endif /* PERL_RE_BUILD_AUX */
 
 /*XXX: todo make this not included in a non debugging perl, but appears to be
  * used anyway there, in 'use re' */
@@ -7443,6 +7445,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
 }
 
 
+#ifdef PERL_RE_BUILD_AUX
 void
 Perl_populate_anyof_bitmap_from_invlist(pTHX_ regnode *node, SV** invlist_ptr)
 {
@@ -7502,6 +7505,7 @@ Perl_populate_anyof_bitmap_from_invlist(pTHX_ regnode *node, SV** invlist_ptr)
         }
     }
 }
+#endif /* PERL_RE_BUILD_AUX */
 
 /* Parse POSIX character classes: [[:foo:]], [[=foo=]], [[.foo.]].
    Character classes ([:foo:]) can also be negated ([:^foo:]).
@@ -9095,6 +9099,7 @@ S_dump_regex_sets_structures(pTHX_ RExC_state_t *pRExC_state,
 #undef IS_OPERATOR
 #undef IS_OPERAND
 
+#ifdef PERL_RE_BUILD_AUX
 void
 Perl_add_above_Latin1_folds(pTHX_ RExC_state_t *pRExC_state, const U8 cp, SV** invlist)
 {
@@ -9182,6 +9187,8 @@ Perl_add_above_Latin1_folds(pTHX_ RExC_state_t *pRExC_state, const U8 cp, SV** i
          }
     }
 }
+#endif /* PERL_RE_BUILD_AUX */
+
 
 STATIC void
 S_output_posix_warnings(pTHX_ RExC_state_t *pRExC_state, AV* posix_warnings)
@@ -12105,6 +12112,7 @@ S_optimize_regclass(pTHX_
 
 #undef HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION
 
+#ifdef PERL_RE_BUILD_AUX
 void
 Perl_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state,
                 regnode* const node,
@@ -12261,6 +12269,7 @@ Perl_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state,
     RExC_rxi->data->data[n] = (void*)rv;
     ARG1u_SET(node, n);
 }
+#endif /* PERL_RE_BUILD_AUX */
 
 SV *
 
@@ -12999,6 +13008,8 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p,
 }
 #endif
 
+
+#ifdef PERL_RE_BUILD_AUX
 SV*
 Perl_get_ANYOFM_contents(pTHX_ const regnode * n) {
 
@@ -13047,7 +13058,7 @@ Perl_get_ANYOFHbbm_contents(pTHX_ const regnode * n) {
                                       UTF_CONTINUATION_MARK | 0));
     return cp_list;
 }
-
+#endif /* PERL_RE_BUILD_AUX */
 
 
 SV *
diff --git a/regcomp.h b/regcomp.h
index 31c91e6a68e8..017a9f843514 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -1554,7 +1554,19 @@ typedef enum {
 #define EVAL_OPTIMISTIC_FLAG    128
 #define EVAL_FLAGS_MASK         (EVAL_OPTIMISTIC_FLAG-1)
 
-
+/* We define PERL_RE_BUILD_DEBUG if we are NOT compiling the re extension and
+ * we are under DEBUGGING, or if we are ARE compiling the re extension
+ * and this is not a DEBUGGING enabled build (identified by
+ * DEBUGGING_RE_ONLY being defined)
+ */
+#if ( defined(USE_DYNAMIC_LOADING) && defined(DEBUGGING)) || \
+    ( defined(PERL_EXT_RE_BUILD) && defined(DEBUGGING_RE_ONLY)) || \
+    (!defined(PERL_EXT_RE_BUILD) && defined(DEBUGGING))
+#define PERL_RE_BUILD_DEBUG
+#endif
+#if ( defined(USE_DYNAMIC_LOADING) || !defined(PERL_EXT_RE_BUILD) )
+#define PERL_RE_BUILD_AUX
+#endif
 
 #endif /* PERL_REGCOMP_H_ */
 
diff --git a/regcomp_debug.c b/regcomp_debug.c
index 93db7a89cf48..96598c49c0bc 100644
--- a/regcomp_debug.c
+++ b/regcomp_debug.c
@@ -18,8 +18,7 @@
 #include "unicode_constants.h"
 #include "regcomp_internal.h"
 
-#ifdef DEBUGGING
-
+#ifdef PERL_RE_BUILD_DEBUG
 int
 Perl_re_printf(pTHX_ const char *fmt, ...)
 {
@@ -159,13 +158,160 @@ Perl_debug_peep(pTHX_ const char *str, const RExC_state_t *pRExC_state,
    });
 }
 
-#endif /* DEBUGGING */
+const regnode *
+Perl_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
+            const regnode *last, const regnode *plast,
+            SV* sv, I32 indent, U32 depth)
+{
+    const regnode *next;
+    const regnode *optstart= NULL;
+
+    RXi_GET_DECL(r, ri);
+    DECLARE_AND_GET_RE_DEBUG_FLAGS;
+
+    PERL_ARGS_ASSERT_DUMPUNTIL;
+
+#ifdef DEBUG_DUMPUNTIL
+    Perl_re_printf( aTHX_  "--- %d : %d - %d - %d\n", indent, node-start,
+        last ? last-start : 0, plast ? plast-start : 0);
+#endif
+
+    if (plast && plast < last)
+        last= plast;
+
+    while (node && (!last || node < last)) {
+        const U8 op = OP(node);
+
+        if (op == CLOSE || op == SRCLOSE || op == WHILEM)
+            indent--;
+        next = regnext((regnode *)node);
+        const regnode *after = regnode_after((regnode *)node,0);
+
+        /* Where, what. */
+        if (op == OPTIMIZED) {
+            if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE))
+                optstart = node;
+            else
+                goto after_print;
+        } else
+            CLEAR_OPTSTART;
+
+        regprop(r, sv, node, NULL, NULL);
+        Perl_re_printf( aTHX_  "%4" IVdf ":%*s%s", (IV)(node - start),
+                      (int)(2*indent + 1), "", SvPVX_const(sv));
+
+        if (op != OPTIMIZED) {
+            if (next == NULL)           /* Next ptr. */
+                Perl_re_printf( aTHX_  " (0)");
+            else if (REGNODE_TYPE(op) == BRANCH
+                     && REGNODE_TYPE(OP(next)) != BRANCH )
+                Perl_re_printf( aTHX_  " (FAIL)");
+            else
+                Perl_re_printf( aTHX_  " (%" IVdf ")", (IV)(next - start));
+            Perl_re_printf( aTHX_ "\n");
+        }
+
+      after_print:
+        if (REGNODE_TYPE(op) == BRANCHJ) {
+            assert(next);
+            const regnode *nnode = (OP(next) == LONGJMP
+                                   ? regnext((regnode *)next)
+                                   : next);
+            if (last && nnode > last)
+                nnode = last;
+            DUMPUNTIL(after, nnode);
+        }
+        else if (REGNODE_TYPE(op) == BRANCH) {
+            assert(next);
+            DUMPUNTIL(after, next);
+        }
+        else if ( REGNODE_TYPE(op)  == TRIE ) {
+            const regnode *this_trie = node;
+            const U32 n = ARG1u(node);
+            const reg_ac_data * const ac = op>=AHOCORASICK ?
+               (reg_ac_data *)ri->data->data[n] :
+               NULL;
+            const reg_trie_data * const trie =
+                (reg_trie_data*)ri->data->data[op<AHOCORASICK ? n : ac->trie];
+#ifdef DEBUGGING
+            AV *const trie_words
+                           = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
+#endif
+            const regnode *nextbranch= NULL;
+            I32 word_idx;
+            SvPVCLEAR(sv);
+            for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) {
+                SV ** const elem_ptr = av_fetch_simple(trie_words, word_idx, 0);
+
+                Perl_re_indentf( aTHX_  "%s ",
+                    indent+3,
+                    elem_ptr
+                    ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr),
+                                SvCUR(*elem_ptr), PL_dump_re_max_len,
+                                PL_colors[0], PL_colors[1],
+                                (SvUTF8(*elem_ptr)
+                                 ? PERL_PV_ESCAPE_UNI
+                                 : 0)
+                                | PERL_PV_PRETTY_ELLIPSES
+                                | PERL_PV_PRETTY_LTGT
+                            )
+                    : "???"
+                );
+                if (trie->jump) {
+                    U16 dist= trie->jump[word_idx+1];
+                    Perl_re_printf( aTHX_  "(%" UVuf ")\n",
+                               (UV)((dist ? this_trie + dist : next) - start));
+                    if (dist) {
+                        if (!nextbranch)
+                            nextbranch= this_trie + trie->jump[0];
+                        DUMPUNTIL(this_trie + dist, nextbranch);
+                    }
+                    if (nextbranch && REGNODE_TYPE(OP(nextbranch))==BRANCH)
+                        nextbranch= regnext((regnode *)nextbranch);
+                } else {
+                    Perl_re_printf( aTHX_  "\n");
+                }
+            }
+            if (last && next > last)
+                node= last;
+            else
+                node= next;
+        }
+        else if ( op == CURLY ) {   /* "next" might be very big: optimizer */
+            DUMPUNTIL(after, after + 1); /* +1 is NOT a REGNODE_AFTER */
+        }
+        else if (REGNODE_TYPE(op) == CURLY && op != CURLYX) {
+            assert(next);
+            DUMPUNTIL(after, next);
+        }
+        else if ( op == PLUS || op == STAR) {
+            DUMPUNTIL(after, after + 1); /* +1 NOT a REGNODE_AFTER */
+        }
+        else if (REGNODE_TYPE(op) == EXACT || op == ANYOFHs) {
+            /* Literal string, where present. */
+            node = (const regnode *)REGNODE_AFTER_varies(node);
+        }
+        else {
+            node = REGNODE_AFTER_opcode(node,op);
+        }
+        if (op == CURLYX || op == OPEN || op == SROPEN)
+            indent++;
+        if (REGNODE_TYPE(op) == END)
+            break;
+    }
+    CLEAR_OPTSTART;
+#ifdef DEBUG_DUMPUNTIL
+    Perl_re_printf( aTHX_  "--- %d\n", (int)indent);
+#endif
+    return node;
+}
+
+#endif  /* PERL_RE_BUILD_DEBUG */
 
 /*
  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
 #ifdef DEBUGGING
-
 static void
 S_regdump_intflags(pTHX_ const char *lead, const U32 flags)
 {
@@ -907,8 +1053,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_
 #endif  /* DEBUGGING */
 }
 
-#ifdef DEBUGGING
 
+#ifdef DEBUGGING
 STATIC void
 S_put_code_point(pTHX_ SV *sv, UV c)
 {
@@ -1517,154 +1663,4 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv,
 
     return did_output_something;
 }
-
-
-const regnode *
-Perl_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
-            const regnode *last, const regnode *plast,
-            SV* sv, I32 indent, U32 depth)
-{
-    const regnode *next;
-    const regnode *optstart= NULL;
-
-    RXi_GET_DECL(r, ri);
-    DECLARE_AND_GET_RE_DEBUG_FLAGS;
-
-    PERL_ARGS_ASSERT_DUMPUNTIL;
-
-#ifdef DEBUG_DUMPUNTIL
-    Perl_re_printf( aTHX_  "--- %d : %d - %d - %d\n", indent, node-start,
-        last ? last-start : 0, plast ? plast-start : 0);
-#endif
-
-    if (plast && plast < last)
-        last= plast;
-
-    while (node && (!last || node < last)) {
-        const U8 op = OP(node);
-
-        if (op == CLOSE || op == SRCLOSE || op == WHILEM)
-            indent--;
-        next = regnext((regnode *)node);
-        const regnode *after = regnode_after((regnode *)node,0);
-
-        /* Where, what. */
-        if (op == OPTIMIZED) {
-            if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE))
-                optstart = node;
-            else
-                goto after_print;
-        } else
-            CLEAR_OPTSTART;
-
-        regprop(r, sv, node, NULL, NULL);
-        Perl_re_printf( aTHX_  "%4" IVdf ":%*s%s", (IV)(node - start),
-                      (int)(2*indent + 1), "", SvPVX_const(sv));
-
-        if (op != OPTIMIZED) {
-            if (next == NULL)           /* Next ptr. */
-                Perl_re_printf( aTHX_  " (0)");
-            else if (REGNODE_TYPE(op) == BRANCH
-                     && REGNODE_TYPE(OP(next)) != BRANCH )
-                Perl_re_printf( aTHX_  " (FAIL)");
-            else
-                Perl_re_printf( aTHX_  " (%" IVdf ")", (IV)(next - start));
-            Perl_re_printf( aTHX_ "\n");
-        }
-
-      after_print:
-        if (REGNODE_TYPE(op) == BRANCHJ) {
-            assert(next);
-            const regnode *nnode = (OP(next) == LONGJMP
-                                   ? regnext((regnode *)next)
-                                   : next);
-            if (last && nnode > last)
-                nnode = last;
-            DUMPUNTIL(after, nnode);
-        }
-        else if (REGNODE_TYPE(op) == BRANCH) {
-            assert(next);
-            DUMPUNTIL(after, next);
-        }
-        else if ( REGNODE_TYPE(op)  == TRIE ) {
-            const regnode *this_trie = node;
-            const U32 n = ARG1u(node);
-            const reg_ac_data * const ac = op>=AHOCORASICK ?
-               (reg_ac_data *)ri->data->data[n] :
-               NULL;
-            const reg_trie_data * const trie =
-                (reg_trie_data*)ri->data->data[op<AHOCORASICK ? n : ac->trie];
-#ifdef DEBUGGING
-            AV *const trie_words
-                           = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
-#endif
-            const regnode *nextbranch= NULL;
-            I32 word_idx;
-            SvPVCLEAR(sv);
-            for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) {
-                SV ** const elem_ptr = av_fetch_simple(trie_words, word_idx, 0);
-
-                Perl_re_indentf( aTHX_  "%s ",
-                    indent+3,
-                    elem_ptr
-                    ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr),
-                                SvCUR(*elem_ptr), PL_dump_re_max_len,
-                                PL_colors[0], PL_colors[1],
-                                (SvUTF8(*elem_ptr)
-                                 ? PERL_PV_ESCAPE_UNI
-                                 : 0)
-                                | PERL_PV_PRETTY_ELLIPSES
-                                | PERL_PV_PRETTY_LTGT
-                            )
-                    : "???"
-                );
-                if (trie->jump) {
-                    U16 dist= trie->jump[word_idx+1];
-                    Perl_re_printf( aTHX_  "(%" UVuf ")\n",
-                               (UV)((dist ? this_trie + dist : next) - start));
-                    if (dist) {
-                        if (!nextbranch)
-                            nextbranch= this_trie + trie->jump[0];
-                        DUMPUNTIL(this_trie + dist, nextbranch);
-                    }
-                    if (nextbranch && REGNODE_TYPE(OP(nextbranch))==BRANCH)
-                        nextbranch= regnext((regnode *)nextbranch);
-                } else {
-                    Perl_re_printf( aTHX_  "\n");
-                }
-            }
-            if (last && next > last)
-                node= last;
-            else
-                node= next;
-        }
-        else if ( op == CURLY ) {   /* "next" might be very big: optimizer */
-            DUMPUNTIL(after, after + 1); /* +1 is NOT a REGNODE_AFTER */
-        }
-        else if (REGNODE_TYPE(op) == CURLY && op != CURLYX) {
-            assert(next);
-            DUMPUNTIL(after, next);
-        }
-        else if ( op == PLUS || op == STAR) {
-            DUMPUNTIL(after, after + 1); /* +1 NOT a REGNODE_AFTER */
-        }
-        else if (REGNODE_TYPE(op) == EXACT || op == ANYOFHs) {
-            /* Literal string, where present. */
-            node = (const regnode *)REGNODE_AFTER_varies(node);
-        }
-        else {
-            node = REGNODE_AFTER_opcode(node,op);
-        }
-        if (op == CURLYX || op == OPEN || op == SROPEN)
-            indent++;
-        if (REGNODE_TYPE(op) == END)
-            break;
-    }
-    CLEAR_OPTSTART;
-#ifdef DEBUG_DUMPUNTIL
-    Perl_re_printf( aTHX_  "--- %d\n", (int)indent);
-#endif
-    return node;
-}
-
-#endif  /* DEBUGGING */
+#endif /* DEBUGGING */
diff --git a/regcomp_invlist.c b/regcomp_invlist.c
index 9ea3f431817d..82f82305846a 100644
--- a/regcomp_invlist.c
+++ b/regcomp_invlist.c
@@ -18,7 +18,7 @@
 #include "unicode_constants.h"
 #include "regcomp_internal.h"
 
-
+#ifdef PERL_RE_BUILD_AUX
 void
 Perl_populate_bitmap_from_invlist(pTHX_ SV * invlist, const UV offset, const U8 * bitmap, const Size_t len)
 {
@@ -70,6 +70,7 @@ Perl_populate_invlist_from_bitmap(pTHX_ const U8 * bitmap, const Size_t bitmap_l
         }
     }
 }
+#endif /* PERL_RE_BUILD_AUX */
 
 /* This section of code defines the inversion list object and its methods.  The
  * interfaces are highly subject to change, so as much as possible is static to
diff --git a/regexec.c b/regexec.c
index c404d9aa3d73..de0b7c461918 100644
--- a/regexec.c
+++ b/regexec.c
@@ -4428,7 +4428,8 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp)
 */
 #define REPORT_CODE_OFF 29
 #define INDENT_CHARS(depth) ((int)(depth) % 20)
-#ifdef DEBUGGING
+
+#ifdef PERL_RE_BUILD_DEBUG
 int
 Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...)
 {