diff options
| -rw-r--r-- | dump.c | 7 | ||||
| -rw-r--r-- | embed.fnc | 6 | ||||
| -rw-r--r-- | embed.h | 3 | ||||
| -rw-r--r-- | proto.h | 9 | ||||
| -rw-r--r-- | regcomp.c | 40 |
5 files changed, 51 insertions, 14 deletions
@@ -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", @@ -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 @@ -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) @@ -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__ @@ -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 |