inline.h: Silence compiler warning

[perl5.git] / dump.c

diff --git a/dump.c b/dump.c
index b2f0fc5..227eb99 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -493,9 +493,10 @@ Perl_sv_peek(pTHX_ SV *sv)
        }
     }
     else if (SvNOKp(sv)) {
-       STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_SET_STANDARD();
        Perl_sv_catpvf(aTHX_ t, "(%" NVgf ")",SvNVX(sv));
-       RESTORE_LC_NUMERIC_UNDERLYING();
+        RESTORE_LC_NUMERIC();
     }
     else if (SvIOKp(sv)) {
        if (SvIsUV(sv))
@@ -609,10 +610,12 @@ S_opdump_indent(pTHX_ const OP *o, I32 level, UV bar, PerlIO *file,
  */
 
 static void
-S_opdump_link(pTHX_ const OP *o, PerlIO *file)
+S_opdump_link(pTHX_ const OP *base, const OP *o, PerlIO *file)
 {
     PerlIO_puts(file, " ===> ");
-    if (o)
+    if (o == base)
+        PerlIO_puts(file, "[SELF]\n");
+    else if (o)
         PerlIO_printf(file, "%" UVuf " [%s 0x%" UVxf "]\n",
             sequence_num(o), OP_NAME(o), PTR2UV(o));
     else
@@ -993,10 +996,15 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
 
     PerlIO_printf(file, " %s(0x%" UVxf ")",
                     op_class_names[op_class(o)], PTR2UV(o));
-    S_opdump_link(aTHX_ o->op_next, file);
+    S_opdump_link(aTHX_ o, o->op_next, file);
 
     /* print op common fields */
 
+    if (level == 0) {
+        S_opdump_indent(aTHX_ o, level, bar, file, "PARENT");
+        S_opdump_link(aTHX_ o, op_parent((OP*)o), file);
+    }
+
     if (o->op_targ && optype != OP_NULL)
            S_opdump_indent(aTHX_ o, level, bar, file, "TARG = %ld\n",
                 (long)o->op_targ);
@@ -1201,11 +1209,11 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
     case OP_ENTERITER:
     case OP_ENTERLOOP:
        S_opdump_indent(aTHX_ o, level, bar, file, "REDO");
-        S_opdump_link(aTHX_ cLOOPo->op_redoop, file);
+        S_opdump_link(aTHX_ o, cLOOPo->op_redoop, file);
        S_opdump_indent(aTHX_ o, level, bar, file, "NEXT");
-        S_opdump_link(aTHX_ cLOOPo->op_nextop, file);
+        S_opdump_link(aTHX_ o, cLOOPo->op_nextop, file);
        S_opdump_indent(aTHX_ o, level, bar, file, "LAST");
-        S_opdump_link(aTHX_ cLOOPo->op_lastop, file);
+        S_opdump_link(aTHX_ o, cLOOPo->op_lastop, file);
        break;
 
     case OP_REGCOMP:
@@ -1226,7 +1234,7 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
     case OP_ENTERTRY:
     case OP_ONCE:
        S_opdump_indent(aTHX_ o, level, bar, file, "OTHER");
-        S_opdump_link(aTHX_ cLOGOPo->op_other, file);
+        S_opdump_link(aTHX_ o, cLOGOPo->op_other, file);
        break;
     case OP_SPLIT:
     case OP_MATCH:
@@ -1263,10 +1271,42 @@ 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 */
+#ifndef USE_ITHREADS
+       /* with ITHREADS, swash is stored in the pad, and the right pad
+        * may not be active here, so skip */
             S_opdump_indent(aTHX_ o, level, bar, file,
-                            "PV = 0x%" UVxf "\n",
-                            PTR2UV(cPVOPo->op_pv));
-            break;
+                            "SWASH = 0x%" UVxf "\n",
+                            PTR2UV(MUTABLE_SV(cSVOPo->op_sv)));
+#endif
+        }
+        else {
+            const OPtrans_map * const tbl = (OPtrans_map*)cPVOPo->op_pv;
+            SSize_t i, size = tbl->size;
+
+            S_opdump_indent(aTHX_ o, level, bar, file,
+                            "TABLE = 0x%" UVxf "\n",
+                            PTR2UV(tbl));
+            S_opdump_indent(aTHX_ o, level, bar, file,
+                "  SIZE: 0x%" UVxf "\n", (UV)size);
+
+            /* dump size+1 values, to include the extra slot at the end */
+            for (i = 0; i <= size; i++) {
+                short val = tbl->map[i];
+                if ((i & 0xf) == 0)
+                    S_opdump_indent(aTHX_ o, level, bar, file,
+                        " %4" UVxf ":", (UV)i);
+                if (val < 0)
+                    PerlIO_printf(file, " %2"  IVdf, (IV)val);
+                else
+                    PerlIO_printf(file, " %02" UVxf, (UV)val);
+
+                if ( i == size || (i & 0xf) == 0xf)
+                    PerlIO_printf(file, "\n");
+            }
+        }
+        break;
 
 
     default:
@@ -1794,9 +1834,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                && type != SVt_PVCV && type != SVt_PVFM  && type != SVt_REGEXP
                && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv))
               || type == SVt_NV) {
-       STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD();
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_SET_STANDARD();
        Perl_dump_indent(aTHX_ level, file, "  NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv));
-       RESTORE_LC_NUMERIC_UNDERLYING();
+        RESTORE_LC_NUMERIC();
     }
 
     if (SvROK(sv)) {