This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Don't iterate while changing an inversion list
authorKarl Williamson <public@khwilliamson.com>
Thu, 27 Dec 2012 17:25:48 +0000 (10:25 -0700)
committerKarl Williamson <public@khwilliamson.com>
Fri, 28 Dec 2012 17:38:53 +0000 (10:38 -0700)
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

embed.fnc
embed.h
proto.h
regcomp.c
regen/mk_invlists.pl

index a2c77b2..5e03012 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 9afd442..ac543e5 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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 1151167..d9435b5 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      \
index a07d4a0..085bb62 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> */
index e5083c0..843d6e7 100644 (file)
@@ -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";