regexec.c - harden internals against missing logical_nparens

We can default a 0 rx->logical_nparens to rx->nparens. If rx->logical_nparens
is zero then either rx->nparens is also zero, or it can be defaulted. This
will fix most re::engine::XXX modules that do not know about the new field,
provided they zero the rx structure during construction. If they don't then
this patch won't hurt anything and we will have to patch them directly.

Also mark re_op_compile() as available to extensions. Marking it as hidden
means that re::engine::PCRE2 and others cannot build.

This patch should go a long way towards fixing issue #20710.

4 files changed, 19 insertions, 11 deletions

diff --git a/embed.fnc b/embed.fnc
index 04ce678669..9c9b2ba0bb 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2759,7 +2759,7 @@ Cp	|void	|regfree_internal					\
 EXp	|regexp_engine const *|current_re_engine
 Apdh	|REGEXP *|pregcomp	|NN SV * const pattern			\
 				|const U32 flags
-p	|REGEXP *|re_op_compile |NULLOK SV ** const patternp		\
+Xp	|REGEXP *|re_op_compile |NULLOK SV ** const patternp		\
 				|int pat_count				\
 				|NULLOK OP *expr			\
 				|NN const regexp_engine *eng		\
diff --git a/mg.c b/mg.c
index 83ae360527..5366f5767a 100644
--- a/mg.c
+++ b/mg.c
@@ -638,7 +638,7 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
             const SSize_t n = (SSize_t)mg->mg_obj;
             if (n == '+') {          /* @+ */
                 /* return the number possible */
-                return RX_LOGICAL_NPARENS(rx);
+                return RX_LOGICAL_NPARENS(rx) ? RX_LOGICAL_NPARENS(rx) : RX_NPARENS(rx);
             } else {   /* @- @^CAPTURE  @{^CAPTURE} */
                 I32 paren = RX_LASTPAREN(rx);
 
@@ -674,15 +674,22 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
         /* @{^CAPTURE} does not contain $&, so we need to increment by 1 */
         const I32 paren = mg->mg_len
                         + (n == '\003' ? 1 : 0);
-        SSize_t s;
-        SSize_t t;
+        
         if (paren < 0)
             return 0;
+
+        SSize_t s;
+        SSize_t t;
+        I32 logical_nparens = (I32)RX_LOGICAL_NPARENS(rx);
+
+        if (!logical_nparens) 
+            logical_nparens = (I32)RX_NPARENS(rx);
+
         if (n != '+' && n != '-') {
             CALLREG_NUMBUF_FETCH(rx,paren,sv);
             return 0;
         }
-        if (paren <= (I32)RX_LOGICAL_NPARENS(rx)) {
+        if (paren <= (I32)logical_nparens) {
             I32 true_paren = RX_LOGICAL_TO_PARNO(rx)
                              ? RX_LOGICAL_TO_PARNO(rx)[paren]
                              : paren;
@@ -692,9 +699,9 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                 {
                     SSize_t i;
 
-                    if (n == '+')                /* @+ */
+                    if (n == '+')               /* @+ */
                         i = t;
-                    else if (n == '-')           /* @- */
+                    else                        /* @- */
                         i = s;
 
                     if (RX_MATCH_UTF8(rx)) {
diff --git a/proto.h b/proto.h
index 157a25041d..4f6d9171cc 100644
--- a/proto.h
+++ b/proto.h
@@ -3616,8 +3616,7 @@ Perl_re_intuit_string(pTHX_ REGEXP  * const r);
         assert(r)
 
 PERL_CALLCONV REGEXP *
-Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, OP *expr, const regexp_engine *eng, REGEXP *old_re, bool *is_bare_re, const U32 rx_flags, const U32 pm_flags)
-        __attribute__visibility__("hidden");
+Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, OP *expr, const regexp_engine *eng, REGEXP *old_re, bool *is_bare_re, const U32 rx_flags, const U32 pm_flags);
 #define PERL_ARGS_ASSERT_RE_OP_COMPILE          \
         assert(eng)
 
diff --git a/regexec.c b/regexec.c
index 8a54cfa44f..eeaa40e90f 100644
--- a/regexec.c
+++ b/regexec.c
@@ -12011,6 +12011,7 @@ Perl_reg_numbered_buff_fetch_flags(pTHX_ REGEXP * const re, const I32 paren,
     SSize_t i,t = 0;
     SSize_t s1, t1;
     I32 n = paren;
+    I32 logical_nparens = rx->logical_nparens ? rx->logical_nparens : rx->nparens;
 
     PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_FETCH_FLAGS;
 
@@ -12054,7 +12055,7 @@ Perl_reg_numbered_buff_fetch_flags(pTHX_ REGEXP * const re, const I32 paren,
         i = rx->sublen + rx->suboffset - t;
     }
     else /* when flags is true we do an absolute lookup, and compare against rx->nparens */
-    if (inRANGE(n, 0, flags ? (I32)rx->nparens : (I32)rx->logical_nparens)) {
+    if (inRANGE(n, 0, flags ? (I32)rx->nparens : logical_nparens)) {
         I32 *map = (!flags && n) ? rx->logical_to_parno : NULL;
         I32 true_parno = map ? map[n] : n;
         do {
@@ -12141,6 +12142,7 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv,
     struct regexp *const rx = ReANY(r);
     I32 i;
     I32 s1, t1;
+    I32 logical_nparens = rx->logical_nparens ? rx->logical_nparens : rx->nparens;
 
     PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_LENGTH;
 
@@ -12188,7 +12190,7 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv,
         return 0;
 
       default: /* $& / ${^MATCH}, $1, $2, ... */
-        if (paren <= (I32)rx->logical_nparens) {
+        if (paren <= logical_nparens) {
             I32 true_paren = rx->logical_to_parno
                              ? rx->logical_to_parno[paren]
                              : paren;