This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
handle op_pv better in op_clear() and op_dump()
authorDavid Mitchell <davem@iabyn.com>
Tue, 24 Jan 2017 14:43:05 +0000 (14:43 +0000)
committerDavid Mitchell <davem@iabyn.com>
Tue, 24 Jan 2017 14:56:43 +0000 (14:56 +0000)
In op_clear(), the ops with labels stored in the op_pv field (OP_NEXT etc)
fall-through to the OP_TRANS/OP_TRANSR code, which determines whether to
free op_pv based on the OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF flags, which are
only valid for OP_TRANS/OP_TRANSR. At the moment the fall-through fields
don't use either of those private bits, but in case this changes in
future, only check those flag bits for trans ops.

At the same time, enhance op_dump() to display the OP_PV field of such
ops.

Also, fix a leak I introduced in the recently-added S_gv_display()
function.

dump.c
op.c

diff --git a/dump.c b/dump.c
index ce63f35..349a3e4 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -737,7 +737,7 @@ Perl_dump_eval(pTHX)
 static SV *
 S_gv_display(pTHX_ GV *gv)
 {
-    SV * const name = newSV(0);
+    SV * const name = newSVpvs_flags("", SVs_TEMP);
     if (gv) {
         SV * const raw = newSVpvs_flags("", SVs_TEMP);
         STRLEN len;
@@ -1217,6 +1217,30 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o)
            S_opdump_indent(aTHX_ o, level, bar, file,
                             "REFCNT = %" UVuf "\n", (UV)o->op_targ);
        break;
+
+    case OP_DUMP:
+    case OP_GOTO:
+    case OP_NEXT:
+    case OP_LAST:
+    case OP_REDO:
+       if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
+           break;
+       /* FALLTHROUGH */
+    case OP_TRANS:
+    case OP_TRANSR:
+       if (   (o->op_type == OP_TRANS || o->op_type == OP_TRANSR)
+            && (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)))
+            break;
+
+        {
+            SV * const label = newSVpvs_flags("", SVs_TEMP);
+            generic_pv_escape(label, cPVOPo->op_pv, strlen(cPVOPo->op_pv), 0);
+            S_opdump_indent(aTHX_ o, level, bar, file,
+                            "PV = \"%" SVf "\" (0x%" UVxf ")\n",
+                            SVfARG(label), PTR2UV(cPVOPo->op_pv));
+        }
+
+
     default:
        break;
     }
diff --git a/op.c b/op.c
index 0ba58c7..c4c9fc0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -994,8 +994,9 @@ Perl_op_clear(pTHX_ OP *o)
        /* FALLTHROUGH */
     case OP_TRANS:
     case OP_TRANSR:
-       if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
-           assert(o->op_type == OP_TRANS || o->op_type == OP_TRANSR);
+       if (   (o->op_type == OP_TRANS || o->op_type == OP_TRANSR)
+            && (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)))
+        {
 #ifdef USE_ITHREADS
            if (cPADOPo->op_padix > 0) {
                pad_swipe(cPADOPo->op_padix, TRUE);