regcomp.c: regpiece() Don't match 0 length more than once

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index 8859f1d..e395790 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -21,7 +21,7 @@
  *
  * It also holds the debugging version of the  runops function.
 
-=head1 Display and Dump functions
+=for apidoc_section Display and Dump functions
  */
 
 #include "EXTERN.h"
@@ -132,6 +132,23 @@ sequences, whereas C<"%"> is not a particularly common character in patterns.
 
 Returns a pointer to the escaped text as held by C<dsv>.
 
+=for apidoc Amnh||PERL_PV_ESCAPE_ALL
+=for apidoc Amnh||PERL_PV_ESCAPE_FIRSTCHAR
+=for apidoc Amnh||PERL_PV_ESCAPE_NOBACKSLASH
+=for apidoc Amnh||PERL_PV_ESCAPE_NOCLEAR
+=for apidoc Amnh||PERL_PV_ESCAPE_NONASCII
+=for apidoc Amnh||PERL_PV_ESCAPE_QUOTE
+=for apidoc Amnh||PERL_PV_ESCAPE_RE
+=for apidoc Amnh||PERL_PV_ESCAPE_UNI
+=for apidoc Amnh||PERL_PV_ESCAPE_UNI_DETECT
+
+=cut
+
+Unused or not for public use
+=for apidoc Cmnh||PERL_PV_PRETTY_REGPROP
+=for apidoc Cmnh||PERL_PV_PRETTY_DUMP
+=for apidoc Cmnh||PERL_PV_PRETTY_NOCLEAR
+
 =cut
 */
 #define PV_ESCAPE_OCTBUFSIZE 32
@@ -267,6 +284,10 @@ any quotes or ellipses.
 
 Returns a pointer to the prettified text as held by C<dsv>.
 
+=for apidoc Amnh||PERL_PV_PRETTY_QUOTE
+=for apidoc Amnh||PERL_PV_PRETTY_LTGT
+=for apidoc Amnh||PERL_PV_PRETTY_ELLIPSES
+
 =cut           
 */
 
@@ -353,7 +374,6 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv
 char *
 Perl_sv_peek(pTHX_ SV *sv)
 {
-    dVAR;
     SV * const t = sv_newmortal();
     int unref = 0;
     U32 type;
@@ -515,10 +535,6 @@ Perl_sv_peek(pTHX_ SV *sv)
     return SvPV_nolen(t);
 }
 
-/*
-=head1 Debugging Utilities
-*/
-
 void
 Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 {
@@ -915,7 +931,6 @@ Perl_pmop_dump(pTHX_ PMOP *pm)
 STATIC UV
 S_sequence_num(pTHX_ const OP *o)
 {
-    dVAR;
     SV     *op,
           **seq;
     const char *key;
@@ -1004,6 +1019,26 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
         S_opdump_indent(aTHX_ o, level, bar, file, "PARENT");
         S_opdump_link(aTHX_ o, op_parent((OP*)o), file);
     }
+    else if (!OpHAS_SIBLING(o)) {
+        bool ok = TRUE;
+        OP *p = o->op_sibparent;
+        if (!p || !(p->op_flags & OPf_KIDS))
+            ok = FALSE;
+        else {
+            OP *kid = cUNOPx(p)->op_first;
+            while (kid != o) {
+                kid = OpSIBLING(kid);
+                if (!kid) {
+                    ok = FALSE;
+                    break;
+                }
+            }
+        }
+        if (!ok) {
+            S_opdump_indent(aTHX_ o, level, bar, file,
+                            "*** WILD PARENT 0x%p\n", p);
+        }
+    }
 
     if (o->op_targ && optype != OP_NULL)
            S_opdump_indent(aTHX_ o, level, bar, file, "TARG = %ld\n",
@@ -1271,13 +1306,13 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
 
     case OP_TRANS:
     case OP_TRANSR:
-        if (o->op_private & (OPpTRANS_FROM_UTF | OPpTRANS_TO_UTF)) {
-            /* utf8: table stored as a swash */
+        if (o->op_private & OPpTRANS_USE_SVOP) {
+            /* utf8: table stored as an inversion map */
 #ifndef USE_ITHREADS
-       /* with ITHREADS, swash is stored in the pad, and the right pad
+       /* with ITHREADS, it is stored in the pad, and the right pad
         * may not be active here, so skip */
             S_opdump_indent(aTHX_ o, level, bar, file,
-                            "SWASH = 0x%" UVxf "\n",
+                            "INVMAP = 0x%" UVxf "\n",
                             PTR2UV(MUTABLE_SV(cSVOPo->op_sv)));
 #endif
         }
@@ -1390,9 +1425,9 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
     PERL_ARGS_ASSERT_DO_MAGIC_DUMP;
 
     for (; mg; mg = mg->mg_moremagic) {
-       Perl_dump_indent(aTHX_ level, file,
+        Perl_dump_indent(aTHX_ level, file,
                         "  MAGIC = 0x%" UVxf "\n", PTR2UV(mg));
-       if (mg->mg_virtual) {
+        if (mg->mg_virtual) {
             const MGVTBL * const v = mg->mg_virtual;
            if (v >= PL_magic_vtables
                && v < PL_magic_vtables + magic_vtable_max) {
@@ -1728,7 +1763,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            sv_catpvs(d, "PADTMP,");
     append_flags(d, flags, first_sv_flags_names);
     if (flags & SVf_ROK)  {    
-                               sv_catpvs(d, "ROK,");
+                                sv_catpvs(d, "ROK,");
        if (SvWEAKREF(sv))      sv_catpvs(d, "WEAKREF,");
     }
     if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,");
@@ -2951,11 +2986,10 @@ Perl_op_class(pTHX_ const OP *o)
          * pointer to a table of shorts used to look up translations.
          * Under utf8, however, a simple table isn't practical; instead,
          * the OP is an SVOP (or, under threads, a PADOP),
-         * and the SV is a reference to a swash
-         * (i.e., an RV pointing to an HV).
+         * and the SV is an AV.
          */
        return (!custom &&
-                  (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
+                  (o->op_private & OPpTRANS_USE_SVOP)
               )
 #if  defined(USE_ITHREADS)
                ? OPclass_PADOP : OPclass_PVOP;