PATCH: [perl #112530] Panic with inversion lists

The code assumed that all property definitions would be well-formed,
meaning, in part, that they would be numerically sorted by code point,
with each range disjoint from all others.  So, the code was just
appending each range as it is found to the inversion list it is
building.

This assumption is true for all definitions generated by mktables, but
it might not be true for user-defined ones.  The solution is merely to
change from calling the function that appends to instead call the
existing function that handles the more general case.

However, that function was not previously used outside the file it was
defined in, so must now be made public.  Also, this whole interface is
considered volatile, so the names of the public functions in it begin
with an underscore to further discourage XS writers from using them.
Therefore the more general add function is renamed to begin with an
underscore.

And, the append function is no longer needed outside the file it is
defined in, so again to keep XS writers from using it, this commit makes
it static.

diff --git a/embed.fnc b/embed.fnc
index ab2b2f8..9546555 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1368,7 +1368,7 @@ ApR       |SV*    |swash_init     |NN const char* pkg|NN const char* name|NN SV* listsv|I32 m
 Ap     |UV     |swash_fetch    |NN SV *swash|NN const U8 *ptr|bool do_utf8
 #ifdef PERL_IN_REGCOMP_C
 EiMR   |SV*    |add_cp_to_invlist      |NULLOK SV* invlist|const UV cp
-EsMR   |SV*    |add_range_to_invlist   |NULLOK SV* invlist|const UV start|const UV end
+EsM    |void   |_append_range_to_invlist   |NN SV* const invlist|const UV start|const UV end
 EiMR   |UV*    |_invlist_array_init    |NN SV* const invlist|const bool will_have_0
 EiMR   |UV*    |invlist_array  |NN SV* const invlist
 EsM    |void   |invlist_extend    |NN SV* const invlist|const UV len
@@ -1396,7 +1396,7 @@ EXpM      |void   |_invlist_invert_prop|NN SV* const invlist
 EXMpR  |HV*    |_swash_inversion_hash  |NN SV* const swash
 EXMpR  |SV*    |_new_invlist   |IV initial_size
 EXMpR  |SV*    |_swash_to_invlist      |NN SV* const swash
-EXMp   |void   |_append_range_to_invlist   |NN SV* const invlist|const UV start|const UV end
+EXMpR  |SV*    |_add_range_to_invlist  |NULLOK SV* invlist|const UV start|const UV end
 EXMp   |void   |_invlist_populate_swatch   |NN SV* const invlist|const UV start|const UV end|NN U8* swatch
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C)

diff --git a/embed.h b/embed.h
index 41e692c..f7db1e0 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -903,12 +903,12 @@
 #define regcurly(a)            S_regcurly(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_REGCOMP_C)
+#define _append_range_to_invlist(a,b,c)        S__append_range_to_invlist(aTHX_ a,b,c)
 #define _invlist_array_init(a,b)       S__invlist_array_init(aTHX_ a,b)
 #define _new_invlist_C_array(a)        S__new_invlist_C_array(aTHX_ a)
 #define add_alternate(a,b,c)   S_add_alternate(aTHX_ a,b,c)
 #define add_cp_to_invlist(a,b) S_add_cp_to_invlist(aTHX_ a,b)
 #define add_data               S_add_data
-#define add_range_to_invlist(a,b,c)    S_add_range_to_invlist(aTHX_ a,b,c)
 #define checkposixcc(a)                S_checkposixcc(aTHX_ a)
 #define cl_and                 S_cl_and
 #define cl_anything            S_cl_anything
@@ -959,7 +959,7 @@
 #define _invlist_contents(a)   Perl__invlist_contents(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
-#define _append_range_to_invlist(a,b,c)        Perl__append_range_to_invlist(aTHX_ a,b,c)
+#define _add_range_to_invlist(a,b,c)   Perl__add_range_to_invlist(aTHX_ a,b,c)
 #define _invlist_intersection_maybe_complement_2nd(a,b,c,d)    Perl__invlist_intersection_maybe_complement_2nd(aTHX_ a,b,c,d)
 #define _invlist_invert(a)     Perl__invlist_invert(aTHX_ a)
 #define _invlist_invert_prop(a)        Perl__invlist_invert_prop(aTHX_ a)

diff --git a/proto.h b/proto.h
index 11a7d1b..143eee0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6297,6 +6297,11 @@ STATIC SV *      S_space_join_names_mortal(pTHX_ char *const *array)
 
 #endif
 #if defined(PERL_IN_REGCOMP_C)
+STATIC void    S__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT__APPEND_RANGE_TO_INVLIST      \
+       assert(invlist)
+
 PERL_STATIC_INLINE UV* S__invlist_array_init(pTHX_ SV* const invlist, const bool will_have_0)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
@@ -6325,9 +6330,6 @@ STATIC U32        S_add_data(struct RExC_state_t *pRExC_state, U32 n, const char *s)
 #define PERL_ARGS_ASSERT_ADD_DATA      \
        assert(pRExC_state); assert(s)
 
-STATIC SV*     S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end)
-                       __attribute__warn_unused_result__;
-
 STATIC void    S_checkposixcc(pTHX_ struct RExC_state_t *pRExC_state)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_CHECKPOSIXCC  \
@@ -6621,10 +6623,8 @@ PERL_CALLCONV SV*        Perl__invlist_contents(pTHX_ SV* const invlist)
 
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
-PERL_CALLCONV void     Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT__APPEND_RANGE_TO_INVLIST      \
-       assert(invlist)
+PERL_CALLCONV SV*      Perl__add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end)
+                       __attribute__warn_unused_result__;
 
 /* PERL_CALLCONV void  _invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i)
                        __attribute__nonnull__(pTHX_1)

diff --git a/regcomp.c b/regcomp.c
index b106cc1..143f349 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6518,9 +6518,8 @@ S_invlist_trim(pTHX_ SV* const invlist)
 
 #define _invlist_union_complement_2nd(a, b, output) _invlist_union_maybe_complement_2nd(a, b, TRUE, output)
 
-#ifndef PERL_IN_XSUB_RE
-void
-Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end)
+STATIC void
+S__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end)
 {
    /* Subject to change or removal.  Append the range from 'start' to 'end' at
     * the end of the inversion list.  The range must be above any existing
@@ -6598,6 +6597,8 @@ Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV
     }
 }
 
+#ifndef PERL_IN_XSUB_RE
+
 STATIC IV
 S_invlist_search(pTHX_ SV* const invlist, const UV cp)
 {
@@ -7184,10 +7185,8 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
     return;
 }
 
-#endif
-
-STATIC SV*
-S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end)
+SV*
+Perl__add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end)
 {
     /* Add the range from 'start' to 'end' inclusive to the inversion list's
      * set.  A pointer to the inversion list is returned.  This may actually be
@@ -7228,9 +7227,11 @@ S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end)
     return invlist;
 }
 
+#endif
+
 PERL_STATIC_INLINE SV*
 S_add_cp_to_invlist(pTHX_ SV* invlist, const UV cp) {
-    return add_range_to_invlist(invlist, cp, cp);
+    return _add_range_to_invlist(invlist, cp, cp);
 }
 
 #ifndef PERL_IN_XSUB_RE
@@ -11170,7 +11171,7 @@ parseit:
          if (value > 255) {
            const UV prevnatvalue  = NATIVE_TO_UNI(prevvalue);
            const UV natvalue      = NATIVE_TO_UNI(value);
-           nonbitmap = add_range_to_invlist(nonbitmap, prevnatvalue, natvalue);
+           nonbitmap = _add_range_to_invlist(nonbitmap, prevnatvalue, natvalue);
        }
 #ifdef EBCDIC
            literal_endpoint = 0;

diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t
index 15f25b5..d82fcf1 100644 (file)
--- a/t/re/pat_advanced.t
+++ b/t/re/pat_advanced.t
@@ -2149,6 +2149,12 @@ EOP
         }
     }
 
+    { # [perl #112530], the code below caused a panic
+        sub InFoo { "a\tb\n9\ta\n" }
+        like("\n", qr/\p{InFoo}/,
+                            "Overlapping ranges in user-defined properties");
+    }
+
     # !!! NOTE that tests that aren't at all likely to crash perl should go
     # a ways above, above these last ones.
 

diff --git a/utf8.c b/utf8.c
index 1a69dd3..8585eb1 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -3771,7 +3771,7 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
            break;
        }
 
-       _append_range_to_invlist(invlist, start, end);
+       invlist = _add_range_to_invlist(invlist, start, end);
     }
 
     /* Invert if the data says it should be */