4 files changed, 39 insertions, 0 deletions

diff --git a/embed.fnc b/embed.fnc
index 43d79e6b22..ab2cc87465 100644
--- 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 8dcdde85f6..1cd59b22a6 100644
--- 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 9c61e73a53..b9a7a7aaf1 100644
--- 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 ef5b05f8c6..328aac89a6 100644
--- 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)