Move autodie from ext/ to cpan/

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

diff --git a/op.c b/op.c
index cb46cd6..729c25f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -872,12 +872,8 @@ Perl_scalar(pTHX_ OP *o)
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
            scalar(kid);
        break;
-    case OP_SPLIT:
-       if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
-           if (!kPMOP->op_pmreplrootu.op_pmreplroot)
-               deprecate_old("implicit split to @_");
-       }
        /* FALL THROUGH */
+    case OP_SPLIT:
     case OP_MATCH:
     case OP_QR:
     case OP_SUBST:
@@ -1191,12 +1187,6 @@ Perl_scalarvoid(pTHX_ OP *o)
        /* FALL THROUGH */
     case OP_SCALAR:
        return scalar(o);
-    case OP_SPLIT:
-       if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
-           if (!kPMOP->op_pmreplrootu.op_pmreplroot)
-               deprecate_old("implicit split to @_");
-       }
-       break;
     }
     if (useless && ckWARN(WARN_VOID))
        Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless);
@@ -5692,69 +5682,34 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        PL_compcv = NULL;
        goto done;
     }
-    if (attrs) {
-       HV *stash;
-       SV *rcv;
-
-       /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>
-        * before we clobber PL_compcv.
-        */
-       if (cv && (!block
+    if (cv) {                          /* must reuse cv if autoloaded */
+       /* transfer PL_compcv to cv */
+       if (block
 #ifdef PERL_MAD
-                   || block->op_type == OP_NULL
+                  && block->op_type != OP_NULL
 #endif
-                   )) {
-           rcv = MUTABLE_SV(cv);
-           /* Might have had built-in attributes applied -- propagate them. */
-           CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
-           if (CvGV(cv) && GvSTASH(CvGV(cv)))
-               stash = GvSTASH(CvGV(cv));
-           else if (CvSTASH(cv))
-               stash = CvSTASH(cv);
-           else
-               stash = PL_curstash;
+       ) {
+           cv_undef(cv);
+           CvFLAGS(cv) = CvFLAGS(PL_compcv);
+           if (!CvWEAKOUTSIDE(cv))
+               SvREFCNT_dec(CvOUTSIDE(cv));
+           CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
+           CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
+           CvOUTSIDE(PL_compcv) = 0;
+           CvPADLIST(cv) = CvPADLIST(PL_compcv);
+           CvPADLIST(PL_compcv) = 0;
+           /* inner references to PL_compcv must be fixed up ... */
+           pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
+           if (PERLDB_INTER)/* Advice debugger on the new sub. */
+             ++PL_sub_generation;
        }
        else {
-           /* possibly about to re-define existing subr -- ignore old cv */
-           rcv = MUTABLE_SV(PL_compcv);
-           if (name && GvSTASH(gv))
-               stash = GvSTASH(gv);
-           else
-               stash = PL_curstash;
-       }
-       apply_attrs(stash, rcv, attrs, FALSE);
-    }
-    if (cv) {                          /* must reuse cv if autoloaded */
-       if (
-#ifdef PERL_MAD
-           (
-#endif
-            !block
-#ifdef PERL_MAD
-            || block->op_type == OP_NULL) && !PL_madskills
-#endif
-            ) {
-           /* got here with just attrs -- work done, so bug out */
-           SAVEFREESV(PL_compcv);
-           goto done;
+           /* Might have had built-in attributes applied -- propagate them. */
+           CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
        }
-       /* transfer PL_compcv to cv */
-       cv_undef(cv);
-       CvFLAGS(cv) = CvFLAGS(PL_compcv);
-       if (!CvWEAKOUTSIDE(cv))
-           SvREFCNT_dec(CvOUTSIDE(cv));
-       CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
-       CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
-       CvOUTSIDE(PL_compcv) = 0;
-       CvPADLIST(cv) = CvPADLIST(PL_compcv);
-       CvPADLIST(PL_compcv) = 0;
-       /* inner references to PL_compcv must be fixed up ... */
-       pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
        /* ... before we throw it away */
        SvREFCNT_dec(PL_compcv);
        PL_compcv = cv;
-       if (PERLDB_INTER)/* Advice debugger on the new sub. */
-         ++PL_sub_generation;
     }
     else {
        cv = PL_compcv;
@@ -5770,9 +5725,16 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
             mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */
        }
     }
-    CvGV(cv) = gv;
-    CvFILE_set_from_cop(cv, PL_curcop);
-    CvSTASH(cv) = PL_curstash;
+    if (!CvGV(cv)) {
+       CvGV(cv) = gv;
+       CvFILE_set_from_cop(cv, PL_curcop);
+       CvSTASH(cv) = PL_curstash;
+    }
+    if (attrs) {
+       /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
+       HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash;
+       apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE);
+    }
 
     if (ps)
        sv_setpvn(MUTABLE_SV(cv), ps, ps_len);
@@ -5896,7 +5858,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
            SAVECOPFILE(&PL_compiling);
            SAVECOPLINE(&PL_compiling);
 
-           DEBUG_B( dump_sub(gv) );
+           DEBUG_x( dump_sub(gv) );
            Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
            GvCV(gv) = 0;               /* cv has been hijacked */
            call_list(oldscope, PL_beginav);
@@ -5910,7 +5872,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
     } else {
        if (*name == 'E') {
            if strEQ(name, "END") {
-               DEBUG_B( dump_sub(gv) );
+               DEBUG_x( dump_sub(gv) );
                Perl_av_create_and_unshift_one(aTHX_ &PL_endav, MUTABLE_SV(cv));
            } else
                return;
@@ -5941,7 +5903,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
                return;
        } else
            return;
-       DEBUG_B( dump_sub(gv) );
+       DEBUG_x( dump_sub(gv) );
        GvCV(gv) = 0;           /* cv has been hijacked */
     }
 }
@@ -7702,20 +7664,15 @@ Perl_ck_shift(pTHX_ OP *o)
     PERL_ARGS_ASSERT_CK_SHIFT;
 
     if (!(o->op_flags & OPf_KIDS)) {
-       OP *argop;
-       /* FIXME - this can be refactored to reduce code in #ifdefs  */
-#ifdef PERL_MAD
-       OP * const oldo = o;
-#else
-       op_free(o);
-#endif
-       argop = newUNOP(OP_RV2AV, 0,
+       OP *argop = newUNOP(OP_RV2AV, 0,
            scalar(newGVOP(OP_GV, 0, CvUNIQUE(PL_compcv) ? PL_argvgv : PL_defgv)));
 #ifdef PERL_MAD
+       OP * const oldo = o;
        o = newUNOP(type, 0, scalar(argop));
        op_getmad(oldo,o,'O');
        return o;
 #else
+       op_free(o);
        return newUNOP(type, 0, scalar(argop));
 #endif
     }