Extend sv_dump() to dump SVt_INVLIST

This changes the previously unused _invlist_dump() function to be called
from sv_dump() to dump inversion list scalars.  The format for regular
SVt_PVs doesn't give human-friendly output for these.

Since these lists are currently not visible outside the Perl core, the
format is documented only in comments in the function itself.

diff --git a/dump.c b/dump.c
index bbb045a..333f225 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1682,12 +1682,19 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                              pv_display(d, ptr - delta, delta, 0,
                                         pvlim));
            }
+            if (type == SVt_INVLIST) {
+               PerlIO_printf(file, "\n");
+                /* 4 blanks indents 2 beyond the PV, etc */
+                _invlist_dump(file, level, "    ", sv);
+            }
+            else {
            PerlIO_printf(file, "%s", pv_display(d, ptr, SvCUR(sv),
                                                 re ? 0 : SvLEN(sv),
                                                 pvlim));
            if (SvUTF8(sv)) /* the 6?  \x{....} */
                PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ));
            PerlIO_printf(file, "\n");
+            }
            Perl_dump_indent(aTHX_ level, file, "  CUR = %"IVdf"\n", (IV)SvCUR(sv));
            if (!re)
                Perl_dump_indent(aTHX_ level, file, "  LEN = %"IVdf"\n",

diff --git a/embed.fnc b/embed.fnc
index e4cb24d..f3e351e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1479,7 +1479,11 @@ EMiR     |bool   |_invlist_contains_cp|NN SV* const invlist|const UV cp
 EXpMR  |IV     |_invlist_search        |NN SV* const invlist|const UV cp
 EXMpR  |SV*    |_get_swash_invlist|NN SV* const swash
 EXMpR  |HV*    |_swash_inversion_hash  |NN SV* const swash
-: Not used currently: EXMp     |void   |_invlist_dump  |NN SV* const invlist|NN const char * const header
+#endif
+#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
+EXMp   |void   |_invlist_dump  |NN PerlIO *file|I32 level   \
+                               |NN const char* const indent \
+                               |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 94f4c15..9b5125a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -950,6 +950,9 @@
 #define scan_commit(a,b,c,d)   S_scan_commit(aTHX_ a,b,c,d)
 #define study_chunk(a,b,c,d,e,f,g,h,i,j,k)     S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k)
 #  endif
+#  if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
+#define _invlist_dump(a,b,c,d) Perl__invlist_dump(aTHX_ a,b,c,d)
+#  endif
 #  if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C)
 #define _get_swash_invlist(a)  Perl__get_swash_invlist(aTHX_ a)
 #define _invlist_contains_cp(a,b)      S__invlist_contains_cp(aTHX_ a,b)

diff --git a/proto.h b/proto.h
index 8599884..e57f3ea 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6767,6 +6767,15 @@ STATIC I32       S_study_chunk(pTHX_ struct RExC_state_t *pRExC_state, regnode **scanp
        assert(pRExC_state); assert(scanp); assert(minlenp); assert(deltap); assert(last)
 
 #endif
+#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
+PERL_CALLCONV void     Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, const char* const indent, SV* const invlist)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_3)
+                       __attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT__INVLIST_DUMP \
+       assert(file); assert(indent); assert(invlist)
+
+#endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C)
 PERL_CALLCONV SV*      Perl__get_swash_invlist(pTHX_ SV* const swash)
                        __attribute__warn_unused_result__

diff --git a/regcomp.c b/regcomp.c
index 3283054..eac3051 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -8293,40 +8293,54 @@ Perl__invlist_contents(pTHX_ SV* const invlist)
 }
 #endif
 
-#ifdef PERL_ARGS_ASSERT__INVLIST_DUMP
 void
-Perl__invlist_dump(pTHX_ SV* const invlist, const char * const header)
+Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, const char * const indent, SV* const invlist)
 {
-    /* Dumps out the ranges in an inversion list.  The string 'header'
-     * if present is output on a line before the first range */
+    /* Designed to be called only by do_sv_dump().  Dumps out the ranges of the
+     * inversion list 'invlist' to 'file' at 'level'  Each line is prefixed by
+     * the string 'indent'.  The output looks like this:
+         [0] 0x000A .. 0x000D
+         [2] 0x0085
+         [4] 0x2028 .. 0x2029
+         [6] 0x3104 .. INFINITY
+     * This means that the first range of code points matched by the list are
+     * 0xA through 0xD; the second range contains only the single code point
+     * 0x85, etc.  An inversion list is an array of UVs.  Two array elements
+     * are used to define each range (except if the final range extends to
+     * infinity, only a single element is needed).  The array index of the
+     * first element for the corresponding range is given in brackets. */
 
     UV start, end;
+    STRLEN count = 0;
 
     PERL_ARGS_ASSERT__INVLIST_DUMP;
 
-    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");
+        Perl_dump_indent(aTHX_ level, file,
+             "%sCan't dump inversion list because is in middle of iterating\n",
+             indent);
         return;
     }
 
     invlist_iterinit(invlist);
     while (invlist_iternext(invlist, &start, &end)) {
        if (end == UV_MAX) {
-           PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. INFINITY\n", start);
+           Perl_dump_indent(aTHX_ level, file,
+                                            "%s[%d] 0x%04"UVXf" .. INFINITY\n",
+                                        indent, count, start);
        }
        else if (end != start) {
-           PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. 0x%04"UVXf"\n",
-                                                start,         end);
+           Perl_dump_indent(aTHX_ level, file,
+                                         "%s[%d] 0x%04"UVXf" .. 0x%04"UVXf"\n",
+                                    indent, count, start,         end);
        }
        else {
-           PerlIO_printf(Perl_debug_log, "0x%04"UVXf"\n", start);
+           Perl_dump_indent(aTHX_ level, file, "%s[%d] 0x%04"UVXf"\n",
+                                            indent, count, start);
        }
+        count += 2;
     }
 }
-#endif
 
 #ifdef PERL_ARGS_ASSERT__INVLISTEQ
 bool