regcomp.c: Add _invlist_contents() to compactly dump inversion list

This will be used in future commits for debug traces

diff --git a/embed.fnc b/embed.fnc
index 43d79e6..ab2cc87 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1390,6 +1390,7 @@ EXMp      |void   |_invlist_populate_swatch   |NN SV* const invlist|const UV start|cons
 EXp    |SV*    |_core_swash_init|NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits \
                 |I32 none|bool return_if_undef|NULLOK SV* invlist \
                |bool passed_in_invlist_has_user_defined_property
+EXMpR  |SV*    |_invlist_contents|NN SV* const invlist
 #endif
 Ap     |void   |taint_env
 Ap     |void   |taint_proper   |NULLOK const char* f|NN const char *const s

diff --git a/embed.h b/embed.h
index 8dcdde8..1cd59b2 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -945,6 +945,7 @@
 #  endif
 #  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C)
 #define _core_swash_init(a,b,c,d,e,f,g,h)      Perl__core_swash_init(aTHX_ a,b,c,d,e,f,g,h)
+#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)

diff --git a/proto.h b/proto.h
index 9c61e73..b9a7a7a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6537,6 +6537,12 @@ PERL_CALLCONV SV*        Perl__core_swash_init(pTHX_ const char* pkg, const char* name,
 #define PERL_ARGS_ASSERT__CORE_SWASH_INIT      \
        assert(pkg); assert(name); assert(listsv)
 
+PERL_CALLCONV SV*      Perl__invlist_contents(pTHX_ SV* const invlist)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT__INVLIST_CONTENTS     \
+       assert(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)

diff --git a/regcomp.c b/regcomp.c
index ef5b05f..328aac8 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6861,6 +6861,37 @@ S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end)
     return TRUE;
 }
 
+#ifndef PERL_IN_XSUB_RE
+SV *
+Perl__invlist_contents(pTHX_ SV* const invlist)
+{
+    /* Get the contents of an inversion list into a string SV so that they can
+     * be printed out.  It uses the format traditionally done for debug tracing
+     */
+
+    UV start, end;
+    SV* output = newSVpvs("\n");
+
+    PERL_ARGS_ASSERT__INVLIST_CONTENTS;
+
+    invlist_iterinit(invlist);
+    while (invlist_iternext(invlist, &start, &end)) {
+       if (end == UV_MAX) {
+           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\tINFINITY\n", start);
+       }
+       else if (end != start) {
+           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\t%04"UVXf"\n",
+                   start,       end);
+       }
+       else {
+           Perl_sv_catpvf(aTHX_ output, "%04"UVXf"\n", start);
+       }
+    }
+
+    return output;
+}
+#endif
+
 #if 0
 void
 S_invlist_dump(pTHX_ SV* const invlist, const char * const header)