fix bug in change#3728 that might free COPs prematurely;

null(op) now does more thorough scrubbing of the op, which
fixes a few compile-time memory "leaks"

p4raw-link: @3728 on //depot/perl: 7399586d384137f7ae66bcc82a83b0df7dd429e5

p4raw-id: //depot/perl@3739

diff --git a/dump.c b/dump.c
index 328ce8d..28233e9 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -391,7 +391,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
-       if (o->op_type == OP_NULL || o->op_type == OP_SETSTATE)
+       if (o->op_type == OP_NULL)
            Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
        else
            Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ);

diff --git a/embed.h b/embed.h
index 7d229ba..f2b0bfa 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -764,6 +764,7 @@
 #define scalarboolean          S_scalarboolean
 #define too_few_arguments      S_too_few_arguments
 #define too_many_arguments     S_too_many_arguments
+#define op_clear               S_op_clear
 #define null                   S_null
 #define pad_findlex            S_pad_findlex
 #define newDEFSVOP             S_newDEFSVOP
@@ -2076,6 +2077,7 @@
 #define scalarboolean(a)       S_scalarboolean(aTHX_ a)
 #define too_few_arguments(a,b) S_too_few_arguments(aTHX_ a,b)
 #define too_many_arguments(a,b)        S_too_many_arguments(aTHX_ a,b)
+#define op_clear(a)            S_op_clear(aTHX_ a)
 #define null(a)                        S_null(aTHX_ a)
 #define pad_findlex(a,b,c,d,e,f,g)     S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
 #define newDEFSVOP()           S_newDEFSVOP(aTHX)
@@ -4109,6 +4111,8 @@
 #define too_few_arguments      S_too_few_arguments
 #define S_too_many_arguments   CPerlObj::S_too_many_arguments
 #define too_many_arguments     S_too_many_arguments
+#define S_op_clear             CPerlObj::S_op_clear
+#define op_clear               S_op_clear
 #define S_null                 CPerlObj::S_null
 #define null                   S_null
 #define S_pad_findlex          CPerlObj::S_pad_findlex

diff --git a/embed.pl b/embed.pl
index cbd2294..cca15c4 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1800,6 +1800,7 @@ s |OP*    |no_fh_allowed  |OP *o
 s      |OP*    |scalarboolean  |OP *o
 s      |OP*    |too_few_arguments|OP *o|char* name
 s      |OP*    |too_many_arguments|OP *o|char* name
+s      |void   |op_clear       |OP* o
 s      |void   |null           |OP* o
 s      |PADOFFSET|pad_findlex  |char* name|PADOFFSET newoff|U32 seq \
                                |CV* startcv|I32 cx_ix|I32 saweval|U32 flags

diff --git a/op.c b/op.c
index 21df282..755c34e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -648,6 +648,7 @@ void
 Perl_op_free(pTHX_ OP *o)
 {
     register OP *kid, *nextkid;
+    OPCODE type;
 
     if (!o || o->op_seq == (U16)-1)
        return;
@@ -658,22 +659,42 @@ Perl_op_free(pTHX_ OP *o)
            op_free(kid);
        }
     }
+    type = o->op_type;
+    if (type == OP_NULL)
+       type = o->op_targ;
+
+    /* COP* is not cleared by op_clear() so that we may track line
+     * numbers etc even after null() */
+    if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE)
+       cop_free((COP*)o);
+
+    op_clear(o);
+
+#ifdef PL_OP_SLAB_ALLOC
+    if ((char *) o == PL_OpPtr)
+     {
+     }
+#else
+    Safefree(o);
+#endif
+}
 
+STATIC void
+S_op_clear(pTHX_ OP *o)
+{
     switch (o->op_type) {
-    case OP_NULL:
-       o->op_targ = 0; /* Was holding old type, if any. */
-       break;
-    case OP_ENTEREVAL:
-       o->op_targ = 0; /* Was holding hints. */
+    case OP_NULL:      /* Was holding old type, if any. */
+    case OP_ENTEREVAL: /* Was holding hints. */
+#ifdef USE_THREADS
+    case OP_THREADSV:  /* Was holding index into thr->threadsv AV. */
+#endif
+       o->op_targ = 0;
        break;
 #ifdef USE_THREADS
     case OP_ENTERITER:
        if (!(o->op_flags & OPf_SPECIAL))
            break;
        /* FALL THROUGH */
-    case OP_THREADSV:
-       o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
-       break;
 #endif /* USE_THREADS */
     default:
        if (!(o->op_flags & OPf_REF)
@@ -684,16 +705,11 @@ Perl_op_free(pTHX_ OP *o)
     case OP_GV:
     case OP_AELEMFAST:
        SvREFCNT_dec(cGVOPo->op_gv);
-       break;
-    case OP_SETSTATE:
-       o->op_targ = 0; /* Was holding old type. */
-       /* FALL THROUGH */
-    case OP_NEXTSTATE:
-    case OP_DBSTATE:
-       cop_free((COP*)o);
+       cGVOPo->op_gv = Nullgv;
        break;
     case OP_CONST:
        SvREFCNT_dec(cSVOPo->op_sv);
+       cSVOPo->op_sv = Nullsv;
        break;
     case OP_GOTO:
     case OP_NEXT:
@@ -703,31 +719,29 @@ Perl_op_free(pTHX_ OP *o)
            break;
        /* FALL THROUGH */
     case OP_TRANS:
-       if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
+       if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
            SvREFCNT_dec(cSVOPo->op_sv);
-       else
+           cSVOPo->op_sv = Nullsv;
+       }
+       else {
            Safefree(cPVOPo->op_pv);
+           cPVOPo->op_pv = Nullch;
+       }
        break;
     case OP_SUBST:
        op_free(cPMOPo->op_pmreplroot);
+       cPMOPo->op_pmreplroot = Nullop;
        /* FALL THROUGH */
     case OP_PUSHRE:
     case OP_MATCH:
     case OP_QR:
        ReREFCNT_dec(cPMOPo->op_pmregexp);
+       cPMOPo->op_pmregexp = (REGEXP*)NULL;
        break;
     }
 
     if (o->op_targ > 0)
        pad_free(o->op_targ);
-
-#ifdef PL_OP_SLAB_ALLOC
-    if ((char *) o == PL_OpPtr)
-     {
-     }
-#else
-    Safefree(o);
-#endif
 }
 
 STATIC void
@@ -742,10 +756,9 @@ S_cop_free(pTHX_ COP* cop)
 STATIC void
 S_null(pTHX_ OP *o)
 {
-    if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE)
-       cop_free((COP*)o);
-    if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
-       pad_free(o->op_targ);
+    if (o->op_type == OP_NULL)
+       return;
+    op_clear(o);
     o->op_targ = o->op_type;
     o->op_type = OP_NULL;
     o->op_ppaddr = PL_ppaddr[OP_NULL];
@@ -886,9 +899,12 @@ Perl_scalarvoid(pTHX_ OP *o)
     SV* sv;
     U8 want;
 
-    if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE ||
-       (o->op_type == OP_NULL &&
-        (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)))
+    if (o->op_type == OP_NEXTSTATE
+       || o->op_type == OP_SETSTATE
+       || o->op_type == OP_DBSTATE
+       || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
+                                     || o->op_targ == OP_SETSTATE
+                                     || o->op_targ == OP_DBSTATE)))
     {
        dTHR;
        PL_curcop = (COP*)o;            /* for warning below */
@@ -1018,8 +1034,7 @@ Perl_scalarvoid(pTHX_ OP *o)
                }
            }
        }
-       null(o);                /* don't execute a constant */
-       SvREFCNT_dec(sv);       /* don't even remember it */
+       null(o);                /* don't execute or even remember it */
        break;
 
     case OP_POSTINC:
@@ -1690,9 +1705,6 @@ Perl_scope(pTHX_ OP *o)
                o->op_ppaddr = PL_ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
                if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
-                   if (kid->op_targ > 0)
-                       pad_free(kid->op_targ);
-                   kid->op_targ = kid->op_type;
                    kid->op_type = OP_SETSTATE;
                    kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
                }
@@ -3890,7 +3902,7 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
     for (; o; o = o->op_next) {
        OPCODE type = o->op_type;
 
-       if(sv && o->op_next == o) 
+       if (sv && o->op_next == o) 
            return sv;
        if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
            continue;
@@ -5653,6 +5665,7 @@ Perl_peep(pTHX_ register OP *o)
            PL_op_seqmax++;
        PL_op = o;
        switch (o->op_type) {
+       case OP_SETSTATE:
        case OP_NEXTSTATE:
        case OP_DBSTATE:
            PL_curcop = ((COP*)o);              /* for warnings */
@@ -5701,8 +5714,12 @@ Perl_peep(pTHX_ register OP *o)
            }
            goto nothin;
        case OP_NULL:
-           if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+           if (o->op_targ == OP_NEXTSTATE
+               || o->op_targ == OP_DBSTATE
+               || o->op_targ == OP_SETSTATE)
+           {
                PL_curcop = ((COP*)o);
+           }
            goto nothin;
        case OP_SCALAR:
        case OP_LINESEQ:
@@ -5737,7 +5754,6 @@ Perl_peep(pTHX_ register OP *o)
                                <= 255 &&
                    i >= 0)
                {
-                   SvREFCNT_dec(((SVOP*)pop)->op_sv);
                    null(o->op_next);
                    null(pop->op_next);
                    null(pop);

diff --git a/proto.h b/proto.h
index ed2fdb1..291989d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -773,6 +773,7 @@ STATIC OP*  S_no_fh_allowed(pTHX_ OP *o);
 STATIC OP*     S_scalarboolean(pTHX_ OP *o);
 STATIC OP*     S_too_few_arguments(pTHX_ OP *o, char* name);
 STATIC OP*     S_too_many_arguments(pTHX_ OP *o, char* name);
+STATIC void    S_op_clear(pTHX_ OP* o);
 STATIC void    S_null(pTHX_ OP* o);
 STATIC PADOFFSET       S_pad_findlex(pTHX_ char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags);
 STATIC OP*     S_newDEFSVOP(pTHX);