This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Extend sv_dump() to dump SVt_INVLIST
authorKarl Williamson <public@khwilliamson.com>
Tue, 23 Jul 2013 16:48:20 +0000 (10:48 -0600)
committerKarl Williamson <public@khwilliamson.com>
Thu, 1 Aug 2013 19:01:42 +0000 (13:01 -0600)
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.

dump.c
embed.fnc
embed.h
proto.h
regcomp.c

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",
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
 #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__
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