Integrate change #14778 from maintperl;

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

diff --git a/op.c b/op.c
index e68e431..e39850e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1487,7 +1487,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
                        || kid->op_type == OP_METHOD)
                    {
                        UNOP *newop;
-                       
+
                        NewOp(1101, newop, 1, UNOP);
                        newop->op_type = OP_RV2CV;
                        newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
@@ -1497,7 +1497,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
                        newop->op_private |= OPpLVAL_INTRO;
                        break;
                    }
-               
+
                    if (kid->op_type != OP_RV2CV)
                        Perl_croak(aTHX_
                                   "panic: unexpected lvalue entersub "
@@ -1506,12 +1506,12 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    kid->op_private |= OPpLVAL_INTRO;
                    break;      /* Postpone until runtime */
                }
-               
-               okid = kid;             
+
+               okid = kid;
                kid = kUNOP->op_first;
                if (kid->op_type == OP_NULL && kid->op_targ == OP_RV2SV)
                    kid = kUNOP->op_first;
-               if (kid->op_type == OP_NULL)            
+               if (kid->op_type == OP_NULL)
                    Perl_croak(aTHX_
                               "Unexpected constant lvalue entersub "
                               "entry via type/targ %ld:%"UVuf,
@@ -1531,7 +1531,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
                    okid->op_private |= OPpLVAL_INTRO;
                    break;
                }
-               
+
                cv = GvCV(kGVOP_gv);
                if (!cv)
                    goto restore_2cv;
@@ -1578,7 +1578,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
            goto nomod;
        PL_modcount++;
        break;
-       
+
     case OP_COND_EXPR:
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
            mod(kid, type);
@@ -1649,7 +1649,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 
     case OP_PUSHMARK:
        break;
-       
+
     case OP_KEYS:
        if (type != OP_SASSIGN)
            goto nomod;
@@ -2498,30 +2498,6 @@ Perl_fold_constants(pTHX_ register OP *o)
     }
 
   nope:
-    if (!(PL_opargs[type] & OA_OTHERINT))
-       return o;
-
-    if (!(PL_hints & HINT_INTEGER)) {
-       if (type == OP_MODULO
-           || type == OP_DIVIDE
-           || !(o->op_flags & OPf_KIDS))
-       {
-           return o;
-       }
-
-       for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
-           if (curop->op_type == OP_CONST) {
-               if (SvIOK(((SVOP*)curop)->op_sv))
-                   continue;
-               return o;
-           }
-           if (PL_opargs[curop->op_type] & OA_RETINTEGER)
-               continue;
-           return o;
-       }
-       o->op_ppaddr = PL_ppaddr[++(o->op_type)];
-    }
-
     return o;
 }
 
@@ -2546,6 +2522,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     o->op_type = OP_RV2AV;
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
+    o->op_seq = 0;             /* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
     op_free(curop);
@@ -3714,7 +3691,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                            if (gv == PL_defgv || SvCUR(gv) == PL_generation)
                                break;
                            SvCUR(gv) = PL_generation;
-                       }       
+                       }
                    }
                    else
                        break;
@@ -4365,10 +4342,6 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-    CV *outsidecv;
-    CV *freecv = Nullcv;
-    bool is_eval = CvEVAL(cv) && !CvGV(cv);    /* is this eval"" ? */
-
 #ifdef USE_5005THREADS
     if (CvMUTEXP(cv)) {
        MUTEX_DESTROY(CvMUTEXP(cv));
@@ -4404,14 +4377,13 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
     SvPOK_off((SV*)cv);                /* forget prototype */
     CvGV(cv) = Nullgv;
-    outsidecv = CvOUTSIDE(cv);
     /* Since closure prototypes have the same lifetime as the containing
      * CV, they don't hold a refcount on the outside CV.  This avoids
      * the refcount loop between the outer CV (which keeps a refcount to
      * the closure prototype in the pad entry for pp_anoncode()) and the
      * closure prototype, and the ensuing memory leak.  --GSAR */
     if (!CvANON(cv) || CvCLONED(cv))
-       freecv = outsidecv;
+       SvREFCNT_dec(CvOUTSIDE(cv));
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
        SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4420,38 +4392,10 @@ Perl_cv_undef(pTHX_ CV *cv)
     if (CvPADLIST(cv)) {
        /* may be during global destruction */
        if (SvREFCNT(CvPADLIST(cv))) {
-           AV *padlist = CvPADLIST(cv);
-           I32 ix;
-           if (is_eval) {
-               /* inner references to eval's cv must be fixed up */
-               AV *comppad_name = (AV*)AvARRAY(padlist)[0];
-               AV *comppad = (AV*)AvARRAY(padlist)[1];
-               SV **namepad = AvARRAY(comppad_name);
-               SV **curpad = AvARRAY(comppad);
-               for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-                   SV *namesv = namepad[ix];
-                   if (namesv && namesv != &PL_sv_undef
-                       && *SvPVX(namesv) == '&')
-                   {
-                       CV *innercv = (CV*)curpad[ix];
-                       if (innercv && SvTYPE(innercv) == SVt_PVCV
-                           && CvOUTSIDE(innercv) == cv)
-                       {
-                           CvOUTSIDE(innercv) = outsidecv;
-                           if (!CvANON(innercv) || CvCLONED(innercv)) {
-                               (void)SvREFCNT_inc(outsidecv);
-                               if (SvREFCNT(cv))
-                                   SvREFCNT_dec(cv);
-                           }
-                       }
-                   }
-               }
-           }
-           if (freecv)
-               SvREFCNT_dec(freecv);
-           ix = AvFILLp(padlist);
-           while (ix >= 0) {
-               SV* sv = AvARRAY(padlist)[ix--];
+           I32 i = AvFILLp(CvPADLIST(cv));
+           while (i >= 0) {
+               SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
+               SV* sv = svp ? *svp : Nullsv;
                if (!sv)
                    continue;
                if (sv == (SV*)PL_comppad_name)
@@ -4466,8 +4410,6 @@ Perl_cv_undef(pTHX_ CV *cv)
        }
        CvPADLIST(cv) = Nullav;
     }
-    else if (freecv)
-       SvREFCNT_dec(freecv);
     if (CvXSUB(cv)) {
         CvXSUB(cv) = 0;
     }
@@ -5421,7 +5363,7 @@ Perl_oopsAV(pTHX_ OP *o)
        o->op_type = OP_PADAV;
        o->op_ppaddr = PL_ppaddr[OP_PADAV];
        return ref(o, OP_RV2AV);
-       
+
     case OP_RV2SV:
        o->op_type = OP_RV2AV;
        o->op_ppaddr = PL_ppaddr[OP_RV2AV];
@@ -5582,7 +5524,7 @@ Perl_ck_spair(pTHX_ OP *o)
             !(PL_opargs[newop->op_type] & OA_RETSCALAR) ||
             newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
             newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
-       
+
            return o;
        }
        op_free(kUNOP->op_first);
@@ -5949,7 +5891,7 @@ Perl_ck_fun(pTHX_ OP *o)
                    Perl_warner(aTHX_ WARN_SYNTAX,
                        "Useless use of %s with no values",
                        PL_op_desc[type]);
-               
+
                if (kid->op_type == OP_CONST &&
                    (kid->op_private & OPpCONST_BARE))
                {
@@ -6299,7 +6241,7 @@ Perl_ck_listiob(pTHX_ OP *o)
            kid = kid->op_sibling;
        }
     }
-       
+
     if (!kid)
        append_elem(o->op_type, o, newDEFSVOP());
 
@@ -6507,7 +6449,7 @@ Perl_ck_shift(pTHX_ OP *o)
 
     if (!(o->op_flags & OPf_KIDS)) {
        OP *argop;
-       
+
        op_free(o);
 #ifdef USE_5005THREADS
        if (!CvUNIQUE(PL_compcv)) {
@@ -7208,7 +7150,7 @@ Perl_peep(pTHX_ register OP *o)
                }
            }
            break;
-       
+
        case OP_HELEM: {
            UNOP *rop;
            SV *lexname;
@@ -7217,7 +7159,7 @@ Perl_peep(pTHX_ register OP *o)
            I32 ind;
            char *key = NULL;
            STRLEN keylen;
-       
+
            o->op_seq = PL_op_seqmax++;
 
            if (((BINOP*)o)->op_last->op_type != OP_CONST)
@@ -7269,7 +7211,7 @@ Perl_peep(pTHX_ register OP *o)
            *svp = sv;
            break;
        }
-       
+
        case OP_HSLICE: {
            UNOP *rop;
            SV *lexname;
@@ -7399,4 +7341,3 @@ const_sv_xsub(pTHX_ CV* cv)
     ST(0) = (SV*)XSANY.any_ptr;
     XSRETURN(1);
 }
-