add option to omit Changes file, from Abigail <abigail@delanet.com>;

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 858bf00..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,39 +659,57 @@ 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)
-           || (PL_check[o->op_type] != FUNC_NAME_TO_PTR(Perl_ck_ftst)))
+           || (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)))
            break;
        /* FALL THROUGH */
     case OP_GVSV:
     case OP_GV:
     case OP_AELEMFAST:
        SvREFCNT_dec(cGVOPo->op_gv);
-       break;
-    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:
@@ -700,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
@@ -739,8 +756,9 @@ S_cop_free(pTHX_ COP* cop)
 STATIC void
 S_null(pTHX_ OP *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];
@@ -881,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 */
@@ -1013,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:
@@ -1685,8 +1705,8 @@ 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){
-                   cop_free((COP*)kid);
-                   null(kid);
+                   kid->op_type = OP_SETSTATE;
+                   kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
                }
            }
            else
@@ -3882,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;
@@ -4707,6 +4727,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
            kid->op_type = OP_GV;
            SvREFCNT_dec(kid->op_sv);
            kid->op_sv = SvREFCNT_inc(gv);
+           kid->op_ppaddr = PL_ppaddr[OP_GV];
        }
     }
     return o;
@@ -5451,9 +5472,11 @@ Perl_ck_subr(pTHX_ OP *o)
        o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
        null(cvop);             /* disable rv2cv */
        tmpop = (SVOP*)((UNOP*)cvop)->op_first;
-       if (tmpop->op_type == OP_GV) {
+       if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
            cv = GvCVu(tmpop->op_sv);
-           if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
+           if (!cv)
+               tmpop->op_private |= OPpEARLY_CV;
+           else if (SvPOK(cv)) {
                namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
                proto = SvPV((SV*)cv, n_a);
            }
@@ -5548,6 +5571,8 @@ Perl_ck_subr(pTHX_ OP *o)
                case '$':
                    if (o2->op_type != OP_RV2SV
                        && o2->op_type != OP_PADSV
+                       && o2->op_type != OP_HELEM
+                       && o2->op_type != OP_AELEM
                        && o2->op_type != OP_THREADSV)
                    {
                        bad_type(arg, "scalar", gv_ename(namegv), o2);
@@ -5640,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 */
@@ -5688,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:
@@ -5724,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);
@@ -5736,6 +5765,18 @@ Perl_peep(pTHX_ register OP *o)
                    GvAVn(((GVOP*)o)->op_gv);
                }
            }
+           else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
+               GV *gv = cGVOPo->op_gv;
+               if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
+                   /* XXX could check prototype here instead of just carping */
+                   SV *sv = sv_newmortal();
+                   gv_efullname3(sv, gv, Nullch);
+                   Perl_warner(aTHX_ WARN_UNSAFE,
+                               "%s() called too early to check prototype",
+                               SvPV_nolen(sv));
+               }
+           }
+
            o->op_seq = PL_op_seqmax++;
            break;