Upgrade to podlators-2.1.0

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 3997fac..c314caf 100644 (file)
--- a/op.c
+++ b/op.c
@@ -495,8 +495,6 @@ Perl_op_free(pTHX_ OP *o)
            op_free(kid);
        }
     }
-    if (type == OP_NULL)
-       type = (OPCODE)o->op_targ;
 
 #ifdef PERL_DEBUG_READONLY_OPS
     Slab_to_rw(o);
@@ -504,10 +502,16 @@ Perl_op_free(pTHX_ OP *o)
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
-    if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
+    if (type == OP_NEXTSTATE || type == OP_DBSTATE
+           || (type == OP_NULL /* the COP might have been null'ed */
+               && ((OPCODE)o->op_targ == OP_NEXTSTATE
+                   || (OPCODE)o->op_targ == OP_DBSTATE))) {
        cop_free((COP*)o);
     }
 
+    if (type == OP_NULL)
+       type = (OPCODE)o->op_targ;
+
     op_clear(o);
     if (o->op_latefree) {
        o->op_latefreed = 1;
@@ -548,7 +552,7 @@ Perl_op_clear(pTHX_ OP *o)
     switch (o->op_type) {
     case OP_NULL:      /* Was holding old type, if any. */
        if (PL_madskills && o->op_targ != OP_NULL) {
-           o->op_type = (optype)o->op_targ;
+           o->op_type = (Optype)o->op_targ;
            o->op_targ = 0;
            goto retry;
        }
@@ -4380,20 +4384,14 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        HINTS_REFCNT_UNLOCK;
     }
     if (label) {
-       /* Proof of concept for now - for efficiency reasons these are likely
-          to end up being replaced by a custom function in hv.c  */
-       SV *const key = newSVpvs(":");
-       SV *const value = newSVpv(label, 0);
        cop->cop_hints_hash
-           = Perl_refcounted_he_new(aTHX_ cop->cop_hints_hash, key, value);
+           = Perl_store_cop_label(aTHX_ cop->cop_hints_hash, label);
                                                     
        PL_hints |= HINT_BLOCK_SCOPE;
        /* It seems that we need to defer freeing this pointer, as other parts
           of the grammar end up wanting to copy it after this op has been
           created. */
        SAVEFREEPV(label);
-       SvREFCNT_dec(key);
-       SvREFCNT_dec(value);
     }
 
     if (PL_parser && PL_parser->copline == NOLINE)
@@ -4421,6 +4419,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        }
     }
 
+    if (flags & OPf_SPECIAL)
+       op_null((OP*)cop);
     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
 }
 
@@ -5063,7 +5063,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
 
     NewOp(1101, enterop, 1, LOGOP);
-    enterop->op_type = (optype)enter_opcode;
+    enterop->op_type = (Optype)enter_opcode;
     enterop->op_ppaddr = PL_ppaddr[enter_opcode];
     enterop->op_flags =  (U8) OPf_KIDS;
     enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
@@ -6556,7 +6556,7 @@ Perl_ck_exists(pTHX_ OP *o)
        else if (kid->op_type == OP_AELEM)
            o->op_flags |= OPf_SPECIAL;
        else if (kid->op_type != OP_HELEM)
-           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+           Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or a subroutine",
                        OP_DESC(o));
        op_null(kid);
     }
@@ -7415,7 +7415,9 @@ Perl_ck_open(pTHX_ OP *o)
     if (table) {
        SV **svp = hv_fetchs(table, "open_IN", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_IN_RAW;
            else if (mode & O_TEXT)
@@ -7424,7 +7426,9 @@ Perl_ck_open(pTHX_ OP *o)
 
        svp = hv_fetchs(table, "open_OUT", FALSE);
        if (svp && *svp) {
-           const I32 mode = mode_from_discipline(*svp);
+           STRLEN len = 0;
+           const char *d = SvPV_const(*svp, len);
+           const I32 mode = mode_from_discipline(d, len);
            if (mode & O_BINARY)
                o->op_private |= OPpOPEN_OUT_RAW;
            else if (mode & O_TEXT)