regcomp.c: Some code paths didn't terminate an inversion list iteration

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 9782f19..2eba109 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -182,6 +182,7 @@ struct RExC_state_t {
                                            through */
     U32         study_chunk_recursed_bytes;  /* bytes in bitmap */
     I32                in_lookbehind;
+    I32                in_lookahead;
     I32                contains_locale;
     I32                override_recoding;
 #ifdef EBCDIC
@@ -273,6 +274,7 @@ struct RExC_state_t {
 #define RExC_study_chunk_recursed_bytes  \
                                    (pRExC_state->study_chunk_recursed_bytes)
 #define RExC_in_lookbehind     (pRExC_state->in_lookbehind)
+#define RExC_in_lookahead      (pRExC_state->in_lookahead)
 #define RExC_contains_locale   (pRExC_state->contains_locale)
 #ifdef EBCDIC
 #   define RExC_recode_x_to_native (pRExC_state->recode_x_to_native)
@@ -2526,7 +2528,8 @@ is the recommended Unicode-aware way of saying
        if (UTF) {                                                         \
             SV *zlopp = newSV(UTF8_MAXBYTES);                             \
            unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp);      \
-            unsigned const char *const kapow = uvchr_to_utf8(flrbbbbb, val); \
+            unsigned char *const kapow = uvchr_to_utf8(flrbbbbb, val);     \
+            *kapow = '\0';                                                 \
            SvCUR_set(zlopp, kapow - flrbbbbb);                            \
            SvPOK_on(zlopp);                                               \
            SvUTF8_on(zlopp);                                              \
@@ -7621,6 +7624,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     RExC_seen = 0;
     RExC_maxlen = 0;
     RExC_in_lookbehind = 0;
+    RExC_in_lookahead = 0;
     RExC_seen_zerolen = *exp == '^' ? -1 : 0;
 #ifdef EBCDIC
     RExC_recode_x_to_native = 0;
@@ -11077,6 +11081,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
 
     *flagp = 0;                                /* Tentatively. */
 
+    if (RExC_in_lookbehind) {
+       RExC_in_lookbehind++;
+    }
+    if (RExC_in_lookahead) {
+        RExC_in_lookahead++;
+    }
+
     /* Having this true makes it feasible to have a lot fewer tests for the
      * parse pointer being in scope.  For example, we can write
      *      while(isFOO(*RExC_parse)) RExC_parse++;
@@ -11541,10 +11552,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
                 if (RExC_parse >= RExC_end) {
                     vFAIL("Sequence (?... not terminated");
                 }
-
-                /* FALLTHROUGH */
+                RExC_seen_zerolen++;
+                break;
            case '=':           /* (?=...) */
                RExC_seen_zerolen++;
+                RExC_in_lookahead++;
                 break;
            case '!':           /* (?!...) */
                RExC_seen_zerolen++;
@@ -12343,6 +12355,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
     if (RExC_in_lookbehind) {
        RExC_in_lookbehind--;
     }
+    if (RExC_in_lookahead) {
+        RExC_in_lookahead--;
+    }
     if (after_freeze > RExC_npar)
         RExC_npar = after_freeze;
     return(ret);
@@ -13428,15 +13443,21 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
            *flagp |= SIMPLE;
            goto finish_meta_pat;
        case 'K':
-           RExC_seen_zerolen++;
-           ret = reg_node(pRExC_state, KEEPS);
-           *flagp |= SIMPLE;
-           /* XXX:dmq : disabling in-place substitution seems to
-            * be necessary here to avoid cases of memory corruption, as
-            * with: C<$_="x" x 80; s/x\K/y/> -- rgs
-            */
-            RExC_seen |= REG_LOOKBEHIND_SEEN;
-           goto finish_meta_pat;
+            if (!RExC_in_lookbehind && !RExC_in_lookahead) {
+                RExC_seen_zerolen++;
+                ret = reg_node(pRExC_state, KEEPS);
+                *flagp |= SIMPLE;
+                /* XXX:dmq : disabling in-place substitution seems to
+                 * be necessary here to avoid cases of memory corruption, as
+                 * with: C<$_="x" x 80; s/x\K/y/> -- rgs
+                 */
+                RExC_seen |= REG_LOOKBEHIND_SEEN;
+                goto finish_meta_pat;
+            }
+            else {
+                ++RExC_parse; /* advance past the 'K' */
+                vFAIL("\\K not permitted in lookahead/lookbehind");
+            }
        case 'Z':
            ret = reg_node(pRExC_state, SEOL);
            *flagp |= SIMPLE;
@@ -13800,7 +13821,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
                         && num >= RExC_npar
                         /* cannot be an octal escape if it starts with 8 */
                         && *RExC_parse != '8'
-                        /* cannot be an octal escape it it starts with 9 */
+                        /* cannot be an octal escape if it starts with 9 */
                         && *RExC_parse != '9'
                     ) {
                         /* Probably not meant to be a backref, instead likely
@@ -18869,7 +18890,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
 
                     full_cp_count += this_end - this_start + 1;
                 }
-                invlist_iterfinish(cp_list);
 
                 /* At the end of the loop, we count how many bits differ from
                  * the bits in lowest code point, call the count 'd'.  If the
@@ -18898,8 +18918,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                     ret = reganode(pRExC_state, op, lowest_cp);
                     FLAGS(REGNODE_p(ret)) = ANYOFM_mask;
                 }
+
+              done_anyofm:
+                invlist_iterfinish(cp_list);
             }
-          done_anyofm:
 
             if (inverted) {
                 _invlist_invert(cp_list);
@@ -22925,7 +22947,7 @@ Perl_parse_uniprop_string(pTHX_
         /* Certain properties whose values are numeric need special handling.
          * They may optionally be prefixed by 'is'.  Ignore that prefix for the
          * purposes of checking if this is one of those properties */
-        if (memBEGINPs(lookup_name, name_len, "is")) {
+        if (memBEGINPs(lookup_name, j, "is")) {
             lookup_offset = 2;
         }
 
@@ -23091,7 +23113,9 @@ Perl_parse_uniprop_string(pTHX_
             }
 
             /* Store the first real character in the denominator */
-            lookup_name[j++] = name[i];
+            if (i < name_len) {
+                lookup_name[j++] = name[i];
+            }
         }
     }
 
@@ -23109,7 +23133,7 @@ Perl_parse_uniprop_string(pTHX_
 
     /* If the original input began with 'In' or 'Is', it could be a subroutine
      * call to a user-defined property instead of a Unicode property name. */
-    if (    non_pkg_begin + name_len > 2
+    if (    name_len - non_pkg_begin > 2
         &&  name[non_pkg_begin+0] == 'I'
         && (name[non_pkg_begin+1] == 'n' || name[non_pkg_begin+1] == 's'))
     {