regcomp.c: Don't iterate while changing an inversion list

This adds functions to prevent accidental (or deliberate) iteration over
an inversion list while it is being modified.  This is to catch
development errors, and in production builds, the asserts() are likely
no-ops

diff --git a/embed.fnc b/embed.fnc
index a2c77b2e21708eb8477dc150aa97e68fbee31f4f..5e03012ea138ba5ce6b2239c0770c9b71951be94 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1411,10 +1411,12 @@ EiMR    |IV     |invlist_previous_index|NN SV* const invlist
 EiM    |void   |invlist_set_previous_index|NN SV* const invlist|const IV index
 EiM    |void   |invlist_trim   |NN SV* const invlist
 EiMR   |SV*    |invlist_clone  |NN SV* const invlist
+EiMR   |bool   |invlist_is_iterating|NN SV* const invlist
 EiMR   |UV*    |get_invlist_iter_addr  |NN SV* invlist
 EiMR   |UV*    |get_invlist_version_id_addr    |NN SV* invlist
 EiM    |void   |invlist_iterinit|NN SV* invlist
 EsMR   |bool   |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
+EsM    |void   |invlist_iterfinish|NN SV* invlist
 EiMR   |UV     |invlist_highest|NN SV* const invlist
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)

diff --git a/embed.h b/embed.h
index 9afd44278fbc35957baaac1e9f0d50fe41ce1469..ac543e5777434ff7932b52cbdf09e9209e32753c 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -914,6 +914,8 @@
 #define invlist_clone(a)       S_invlist_clone(aTHX_ a)
 #define invlist_extend(a,b)    S_invlist_extend(aTHX_ a,b)
 #define invlist_highest(a)     S_invlist_highest(aTHX_ a)
+#define invlist_is_iterating(a)        S_invlist_is_iterating(aTHX_ a)
+#define invlist_iterfinish(a)  S_invlist_iterfinish(aTHX_ a)
 #define invlist_iterinit(a)    S_invlist_iterinit(aTHX_ a)
 #define invlist_iternext(a,b,c)        S_invlist_iternext(aTHX_ a,b,c)
 #define invlist_max(a)         S_invlist_max(aTHX_ a)

diff --git a/proto.h b/proto.h
index 1151167d646d74d1412864cec877b68ef3252ec3..d9435b59ca95fcab6ef4333d2048d0886072fcdf 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6509,6 +6509,17 @@ PERL_STATIC_INLINE UV    S_invlist_highest(pTHX_ SV* const invlist)
 #define PERL_ARGS_ASSERT_INVLIST_HIGHEST       \
        assert(invlist)
 
+PERL_STATIC_INLINE bool        S_invlist_is_iterating(pTHX_ SV* const invlist)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_INVLIST_IS_ITERATING  \
+       assert(invlist)
+
+STATIC void    S_invlist_iterfinish(pTHX_ SV* invlist)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_INVLIST_ITERFINISH    \
+       assert(invlist)
+
 PERL_STATIC_INLINE void        S_invlist_iterinit(pTHX_ SV* invlist)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_INVLIST_ITERINIT      \

diff --git a/regcomp.c b/regcomp.c
index a07d4a0bc91fdf217cf826bde20a323634e1bcfa..085bb6290143364465510721d4ae32fe222474ca 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -7096,6 +7096,13 @@ S__new_invlist_C_array(pTHX_ UV* list)
         Perl_croak(aTHX_ "panic: Incorrect version for previously generated inversion list");
     }
 
+    /* Initialize the iteration pointer.
+     * XXX This could be done at compile time in charclass_invlists.h, but I
+     * (khw) am not confident that the suffixes for specifying the C constant
+     * UV_MAX are portable, e.g.  'ull' on a 32 bit machine that is configured
+     * to use 64 bits; might need a Configure probe */
+    invlist_iterfinish(invlist);
+
     return invlist;
 }
 
@@ -7613,6 +7620,7 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool co
 
     /*  We may be removing a reference to one of the inputs */
     if (a == *output || b == *output) {
+        assert(! invlist_is_iterating(*output));
        SvREFCNT_dec_NN(*output);
     }
 
@@ -7834,6 +7842,7 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
 
     /*  We may be removing a reference to one of the inputs */
     if (a == *i || b == *i) {
+        assert(! invlist_is_iterating(*i));
        SvREFCNT_dec_NN(*i);
     }
 
@@ -7907,6 +7916,8 @@ Perl__invlist_invert(pTHX_ SV* const invlist)
 
     PERL_ARGS_ASSERT__INVLIST_INVERT;
 
+    assert(! invlist_is_iterating(invlist));
+
     /* The inverse of matching nothing is matching everything */
     if (*len_pos == 0) {
        _append_range_to_invlist(invlist, 0, UV_MAX);
@@ -8012,6 +8023,22 @@ S_invlist_iterinit(pTHX_ SV* invlist)    /* Initialize iterator for invlist */
     *get_invlist_iter_addr(invlist) = 0;
 }
 
+PERL_STATIC_INLINE void
+S_invlist_iterfinish(pTHX_ SV* invlist)
+{
+    /* Terminate iterator for invlist.  This is to catch development errors.
+     * Any iteration that is interrupted before completed should call this
+     * function.  Functions that add code points anywhere else but to the end
+     * of an inversion list assert that they are not in the middle of an
+     * iteration.  If they were, the addition would make the iteration
+     * problematical: if the iteration hadn't reached the place where things
+     * were being added, it would be ok */
+
+    PERL_ARGS_ASSERT_INVLIST_ITERFINISH;
+
+    *get_invlist_iter_addr(invlist) = UV_MAX;
+}
+
 STATIC bool
 S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end)
 {
@@ -8047,6 +8074,14 @@ S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end)
     return TRUE;
 }
 
+PERL_STATIC_INLINE bool
+S_invlist_is_iterating(pTHX_ SV* const invlist)
+{
+    PERL_ARGS_ASSERT_INVLIST_IS_ITERATING;
+
+    return *(get_invlist_iter_addr(invlist)) < UV_MAX;
+}
+
 PERL_STATIC_INLINE UV
 S_invlist_highest(pTHX_ SV* const invlist)
 {
@@ -8090,6 +8125,8 @@ Perl__invlist_contents(pTHX_ SV* const invlist)
 
     PERL_ARGS_ASSERT__INVLIST_CONTENTS;
 
+    assert(! invlist_is_iterating(invlist));
+
     invlist_iterinit(invlist);
     while (invlist_iternext(invlist, &start, &end)) {
        if (end == UV_MAX) {
@@ -8122,6 +8159,11 @@ Perl__invlist_dump(pTHX_ SV* const invlist, const char * const header)
     if (header && strlen(header)) {
        PerlIO_printf(Perl_debug_log, "%s\n", header);
     }
+    if (invlist_is_iterating(invlist)) {
+        PerlIO_printf(Perl_debug_log, "Can't dump because is in middle of iterating\n");
+        return;
+    }
+
     invlist_iterinit(invlist);
     while (invlist_iternext(invlist, &start, &end)) {
        if (end == UV_MAX) {
@@ -12788,6 +12830,7 @@ parseit:
                 RExC_naughty++;
             }
         }
+        invlist_iterfinish(cp_list);
 
         if (op != END) {
             RExC_parse = (char *)orig_parse;
@@ -12847,6 +12890,7 @@ parseit:
                }
            }
        }
+       invlist_iterfinish(cp_list);
 
         /* Done with loop; remove any code points that are in the bitmap from
          * <cp_list> */

diff --git a/regen/mk_invlists.pl b/regen/mk_invlists.pl
index e5083c04358950f1b837281393eddbc4057ee10e..843d6e77c3077b96976b4a182471e3f43eeb9a5b 100644 (file)
--- a/regen/mk_invlists.pl
+++ b/regen/mk_invlists.pl
@@ -57,6 +57,10 @@ sub output_invlist ($$) {
     print $out_fh "\nstatic UV ${name}_invlist[] = {\n";
 
     print $out_fh "\t", scalar @$invlist, ",\t/* Number of elements */\n";
+
+    # This should be UV_MAX, but I (khw) am not confident that the suffixes
+    # for specifying the constant are portable, e.g.  'ull' on a 32 bit
+    # machine that is configured to use 64 bits; might need a Configure probe
     print $out_fh "\t0,\t/* Current iteration position */\n";
     print $out_fh "\t0,\t/* Cache of previous search index result */\n";
     print $out_fh "\t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */\n";