Change spaces to tabs for t/op/tie_fetch_count.t in MANIFEST

[perl5.git] / op.c

diff --git a/op.c b/op.c
index d832c99..9539248 100644 (file)
--- a/op.c
+++ b/op.c
@@ -103,7 +103,14 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #include "perl.h"
 #include "keywords.h"
 
-#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
+#define CALL_A_PEEP(peep, o) CALL_FPTR((peep)->fn)(aTHX_ o, peep)
+
+#define CALL_PEEP(o)                                                   \
+    STMT_START {                                                       \
+       peep_next_t _next_peep = { PL_peepp, NULL };                    \
+       CALL_A_PEEP(&_next_peep, o);                                    \
+    } STMT_END
+
 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) CALL_FPTR(PL_opfreehook)(aTHX_ o)
 
 #if defined(PL_OP_SLAB_ALLOC)
@@ -5459,7 +5466,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        LEAVE;
     }
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
-    CvGV(cv) = NULL;
+    CvGV_set(cv, NULL);
 
     pad_undef(cv);
 
@@ -5476,8 +5483,9 @@ Perl_cv_undef(pTHX_ CV *cv)
     if (CvISXSUB(cv) && CvXSUB(cv)) {
        CvXSUB(cv) = NULL;
     }
-    /* delete all flags except WEAKOUTSIDE */
-    CvFLAGS(cv) &= CVf_WEAKOUTSIDE;
+    /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
+     * ref status of CvOUTSIDE and CvGV */
+    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
 }
 
 void
@@ -5660,7 +5668,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     dVAR;
     GV *gv;
     const char *ps;
-    STRLEN ps_len;
+    STRLEN ps_len = 0; /* init it to avoid false uninit warning from icc */
     register CV *cv = NULL;
     SV *const_sv;
     /* If the subroutine has no body, no attributes, and no builtin attributes
@@ -5844,6 +5852,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
            if (PERLDB_INTER)/* Advice debugger on the new sub. */
              ++PL_sub_generation;
+           if (CvSTASH(cv))
+               sv_del_backref(MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv));
        }
        else {
            /* Might have had built-in attributes applied -- propagate them. */
@@ -5869,9 +5879,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     if (!CvGV(cv)) {
-       CvGV(cv) = gv;
+       CvGV_set(cv, gv);
        CvFILE_set_from_cop(cv, PL_curcop);
        CvSTASH(cv) = PL_curstash;
+       if (PL_curstash)
+           Perl_sv_add_backref(aTHX_ MUTABLE_SV(PL_curstash), MUTABLE_SV(cv));
     }
     if (attrs) {
        /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
@@ -6229,7 +6241,9 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
             mro_method_changed_in(GvSTASH(gv)); /* newXS */
        }
     }
-    CvGV(cv) = gv;
+    if (!name)
+       CvANON_on(cv);
+    CvGV_set(cv, gv);
     (void)gv_fetchfile(filename);
     CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be
                                   an external constant string */
@@ -6238,8 +6252,6 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 
     if (name)
        process_special_blocks(name, gv, cv);
-    else
-       CvANON_on(cv);
 
     return cv;
 }
@@ -6280,7 +6292,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     }
     cv = PL_compcv;
     GvFORM(gv) = cv;
-    CvGV(cv) = gv;
+    CvGV_set(cv, gv);
     CvFILE_set_from_cop(cv, PL_curcop);
 
 
@@ -8510,11 +8522,13 @@ S_is_inplace_av(pTHX_ OP *o, OP *oright) {
  * peep() is called */
 
 void
-Perl_peep(pTHX_ register OP *o)
+Perl_peep(pTHX_ register OP *o, peep_next_t *next_peep)
 {
     dVAR;
     register OP* oldop = NULL;
 
+    PERL_ARGS_ASSERT_PEEP;
+
     if (!o || o->op_opt)
        return;
     ENTER;
@@ -8709,7 +8723,7 @@ Perl_peep(pTHX_ register OP *o)
             sop = fop->op_sibling;
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
-           peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+           CALL_A_PEEP(next_peep, cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
           
           stitch_keys:     
            o->op_opt = 1;
@@ -8760,20 +8774,20 @@ Perl_peep(pTHX_ register OP *o)
        case OP_ONCE:
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
-           peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+           CALL_A_PEEP(next_peep, cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
            break;
 
        case OP_ENTERLOOP:
        case OP_ENTERITER:
            while (cLOOP->op_redoop->op_type == OP_NULL)
                cLOOP->op_redoop = cLOOP->op_redoop->op_next;
-           peep(cLOOP->op_redoop);
+           CALL_A_PEEP(next_peep, cLOOP->op_redoop);
            while (cLOOP->op_nextop->op_type == OP_NULL)
                cLOOP->op_nextop = cLOOP->op_nextop->op_next;
-           peep(cLOOP->op_nextop);
+           CALL_A_PEEP(next_peep, cLOOP->op_nextop);
            while (cLOOP->op_lastop->op_type == OP_NULL)
                cLOOP->op_lastop = cLOOP->op_lastop->op_next;
-           peep(cLOOP->op_lastop);
+           CALL_A_PEEP(next_peep, cLOOP->op_lastop);
            break;
 
        case OP_SUBST:
@@ -8782,7 +8796,7 @@ Perl_peep(pTHX_ register OP *o)
                   cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL)
                cPMOP->op_pmstashstartu.op_pmreplstart
                    = cPMOP->op_pmstashstartu.op_pmreplstart->op_next;
-           peep(cPMOP->op_pmstashstartu.op_pmreplstart);
+           CALL_A_PEEP(next_peep, cPMOP->op_pmstashstartu.op_pmreplstart);
            break;
 
        case OP_EXEC: