X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=5a60a1cd8d1c14f236e9b700ab5aa8b5c3f76edb;hb=88cb3de1190a9c7cb0c9eac7e530563ff68bf2a4;hp=e7f10421cb57675a5436ba948ba5dd09e1286c88;hpb=f34840d8d697d9f8be532dea1352cc0aeefc696b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index e7f1042..5a60a1c 100644
--- a/op.c
+++ b/op.c
@@ -195,7 +195,7 @@ Perl_pad_allocmy(pTHX_ char *name)
 	SV **svp = AvARRAY(PL_comppad_name);
 	HV *ourstash = (PL_curstash ? PL_curstash : PL_defstash);
 	PADOFFSET top = AvFILLp(PL_comppad_name);
-	for (off = top; off > PL_comppad_name_floor; off--) {
+	for (off = top; (I32)off > PL_comppad_name_floor; off--) {
 	    if ((sv = svp[off])
 		&& sv != &PL_sv_undef
 		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
@@ -308,8 +308,8 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 	for (off = AvFILLp(curname); off > 0; off--) {
 	    if ((sv = svp[off]) &&
 		sv != &PL_sv_undef &&
-		seq <= SvIVX(sv) &&
-		seq > I_32(SvNVX(sv)) &&
+		seq <= (U32)SvIVX(sv) &&
+		seq > (U32)I_32(SvNVX(sv)) &&
 		strEQ(SvPVX(sv), name))
 	    {
 		I32 depth;
@@ -471,8 +471,8 @@ Perl_pad_findmy(pTHX_ char *name)
 	if ((sv = svp[off]) &&
 	    sv != &PL_sv_undef &&
 	    (!SvIVX(sv) ||
-	     (seq <= SvIVX(sv) &&
-	      seq > I_32(SvNVX(sv)))) &&
+	     (seq <= (U32)SvIVX(sv) &&
+	      seq > (U32)I_32(SvNVX(sv)))) &&
 	    strEQ(SvPVX(sv), name))
 	{
 	    if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
@@ -778,7 +778,7 @@ Perl_op_free(pTHX_ OP *o)
     }
     type = o->op_type;
     if (type == OP_NULL)
-	type = o->op_targ;
+	type = (OPCODE)o->op_targ;
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
@@ -2310,7 +2310,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     PL_copline = copline;  /* XXX newSTATEOP may reset PL_copline */
     LEAVE_SCOPE(floor);
     PL_pad_reset_pending = FALSE;
-    PL_compiling.op_private = PL_hints;
+    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     if (needblockscope)
 	PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy(PL_comppad_name_fill);
@@ -2547,7 +2547,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
     if (!(PL_opargs[type] & OA_MARK))
 	op_null(cLISTOPo->op_first);
 
-    o->op_type = type;
+    o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
     o->op_flags |= flags;
 
@@ -2664,11 +2664,11 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 
     NewOp(1101, listop, 1, LISTOP);
 
-    listop->op_type = type;
+    listop->op_type = (OPCODE)type;
     listop->op_ppaddr = PL_ppaddr[type];
     if (first || last)
 	flags |= OPf_KIDS;
-    listop->op_flags = flags;
+    listop->op_flags = (U8)flags;
 
     if (!last && first)
 	last = first;
@@ -2696,12 +2696,12 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
 {
     OP *o;
     NewOp(1101, o, 1, OP);
-    o->op_type = type;
+    o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
-    o->op_flags = flags;
+    o->op_flags = (U8)flags;
 
     o->op_next = o;
-    o->op_private = 0 + (flags >> 8);
+    o->op_private = (U8)(0 | (flags >> 8));
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar(o);
     if (PL_opargs[type] & OA_TARGET)
@@ -2720,11 +2720,11 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 	first = force_list(first);
 
     NewOp(1101, unop, 1, UNOP);
-    unop->op_type = type;
+    unop->op_type = (OPCODE)type;
     unop->op_ppaddr = PL_ppaddr[type];
     unop->op_first = first;
     unop->op_flags = flags | OPf_KIDS;
-    unop->op_private = 1 | (flags >> 8);
+    unop->op_private = (U8)(1 | (flags >> 8));
     unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
 	return (OP*)unop;
@@ -2741,21 +2741,21 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     if (!first)
 	first = newOP(OP_NULL, 0);
 
-    binop->op_type = type;
+    binop->op_type = (OPCODE)type;
     binop->op_ppaddr = PL_ppaddr[type];
     binop->op_first = first;
     binop->op_flags = flags | OPf_KIDS;
     if (!last) {
 	last = first;
-	binop->op_private = 1 | (flags >> 8);
+	binop->op_private = (U8)(1 | (flags >> 8));
     }
     else {
-	binop->op_private = 2 | (flags >> 8);
+	binop->op_private = (U8)(2 | (flags >> 8));
 	first->op_sibling = last;
     }
 
     binop = (BINOP*)CHECKOP(type, binop);
-    if (binop->op_next || binop->op_type != type)
+    if (binop->op_next || binop->op_type != (OPCODE)type)
 	return (OP*)binop;
 
     binop->op_last = binop->op_first->op_sibling;
@@ -3015,17 +3015,17 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     tbl = (short*)cPVOPo->op_pv;
     if (complement) {
 	Zero(tbl, 256, short);
-	for (i = 0; i < tlen; i++)
+	for (i = 0; i < (I32)tlen; i++)
 	    tbl[t[i]] = -1;
 	for (i = 0, j = 0; i < 256; i++) {
 	    if (!tbl[i]) {
-		if (j >= rlen) {
+		if (j >= (I32)rlen) {
 		    if (del)
 			tbl[i] = -2;
 		    else if (rlen)
 			tbl[i] = r[j-1];
 		    else
-			tbl[i] = i;
+			tbl[i] = (short)i;
 		}
 		else {
 		    if (i < 128 && r[j] >= 128)
@@ -3040,12 +3040,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 		if (!squash)
 		    o->op_private |= OPpTRANS_IDENTICAL;
 	    }
-	    else if (j >= rlen)
+	    else if (j >= (I32)rlen)
 		j = rlen - 1;
 	    else
 		cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
 	    tbl[0x100] = rlen - j;
-	    for (i=0; i < rlen - j; i++)
+	    for (i=0; i < (I32)rlen - j; i++)
 		tbl[0x101+i] = r[j+i];
 	}
     }
@@ -3060,8 +3060,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	}
 	for (i = 0; i < 256; i++)
 	    tbl[i] = -1;
-	for (i = 0, j = 0; i < tlen; i++,j++) {
-	    if (j >= rlen) {
+	for (i = 0, j = 0; i < (I32)tlen; i++,j++) {
+	    if (j >= (I32)rlen) {
 		if (del) {
 		    if (tbl[t[i]] == -1)
 			tbl[t[i]] = -2;
@@ -3090,10 +3090,10 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     PMOP *pmop;
 
     NewOp(1101, pmop, 1, PMOP);
-    pmop->op_type = type;
+    pmop->op_type = (OPCODE)type;
     pmop->op_ppaddr = PL_ppaddr[type];
-    pmop->op_flags = flags;
-    pmop->op_private = 0 | (flags >> 8);
+    pmop->op_flags = (U8)flags;
+    pmop->op_private = (U8)(0 | (flags >> 8));
 
     if (PL_hints & HINT_RE_TAINT)
 	pmop->op_pmpermflags |= PMf_RETAINT;
@@ -3192,7 +3192,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 	if (pm->op_pmflags & PMf_EVAL) {
 	    curop = 0;
 	    if (CopLINE(PL_curcop) < PL_multi_end)
-		CopLINE_set(PL_curcop, PL_multi_end);
+		CopLINE_set(PL_curcop, (line_t)PL_multi_end);
 	}
 #ifdef USE_5005THREADS
 	else if (repl->op_type == OP_THREADSV
@@ -3284,11 +3284,11 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
     SVOP *svop;
     NewOp(1101, svop, 1, SVOP);
-    svop->op_type = type;
+    svop->op_type = (OPCODE)type;
     svop->op_ppaddr = PL_ppaddr[type];
     svop->op_sv = sv;
     svop->op_next = (OP*)svop;
-    svop->op_flags = flags;
+    svop->op_flags = (U8)flags;
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar((OP*)svop);
     if (PL_opargs[type] & OA_TARGET)
@@ -3301,14 +3301,14 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
     PADOP *padop;
     NewOp(1101, padop, 1, PADOP);
-    padop->op_type = type;
+    padop->op_type = (OPCODE)type;
     padop->op_ppaddr = PL_ppaddr[type];
     padop->op_padix = pad_alloc(type, SVs_PADTMP);
     SvREFCNT_dec(PL_curpad[padop->op_padix]);
     PL_curpad[padop->op_padix] = sv;
     SvPADTMP_on(sv);
     padop->op_next = (OP*)padop;
-    padop->op_flags = flags;
+    padop->op_flags = (U8)flags;
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar((OP*)padop);
     if (PL_opargs[type] & OA_TARGET)
@@ -3332,11 +3332,11 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 {
     PVOP *pvop;
     NewOp(1101, pvop, 1, PVOP);
-    pvop->op_type = type;
+    pvop->op_type = (OPCODE)type;
     pvop->op_ppaddr = PL_ppaddr[type];
     pvop->op_pv = pv;
     pvop->op_next = (OP*)pvop;
-    pvop->op_flags = flags;
+    pvop->op_flags = (U8)flags;
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar((OP*)pvop);
     if (PL_opargs[type] & OA_TARGET)
@@ -3376,9 +3376,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     OP *pack;
     OP *imop;
     OP *veop;
-    char *packname = Nullch;
-    STRLEN packlen = 0;
-    SV *packsv;
 
     if (id->op_type != OP_CONST)
 	Perl_croak(aTHX_ "Module name must be constant");
@@ -3426,7 +3423,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 	pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
 	/* Fake up a method call to import/unimport */
-	meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);;
+	meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
 	(void)SvUPGRADE(meth, SVt_PVIV);
 	(void)SvIOK_on(meth);
 	PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
@@ -3436,15 +3433,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 				   newSVOP(OP_METHOD_NAMED, 0, meth)));
     }
 
-    if (ckWARN(WARN_MISC) &&
-        imop && (imop != arg) && /* no warning on use 5.0; or explicit () */
-        SvPOK(packsv = ((SVOP*)id)->op_sv))
-    {
-        /* BEGIN will free the ops, so we need to make a copy */
-        packlen = SvCUR(packsv);
-        packname = savepvn(SvPVX(packsv), packlen);
-    }
-
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newATTRSUB(floor,
 	newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
@@ -3456,25 +3444,22 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 	        newSTATEOP(0, Nullch, veop)),
 	    newSTATEOP(0, Nullch, imop) ));
 
-    if (packname) {
-	 /* The "did you use incorrect case?" warning used to be here.
-	  * The problem is that on case-insensitive filesystems one
-	  * might get false positives for "use" (and "require"):
-	  * "use Strict" or "require CARP" will work.  This causes
-	  * portability problems for the script: in case-strict
-	  * filesystems the script will stop working.
-	  *
-	  * The "incorrect case" warning checked whether "use Foo"
-	  * imported "Foo" to your namespace, but that is wrong, too:
-	  * there is no requirement nor promise in the language that
-	  * a Foo.pm should or would contain anything in package "Foo".
-	  *
-	  * There is very little Configure-wise that can be done, either:
-	  * the case-sensitivity of the build filesystem of Perl does not
-	  * help in guessing the case-sensitivity of the runtime environment.
-	  */
-        safefree(packname);
-    }
+    /* The "did you use incorrect case?" warning used to be here.
+     * The problem is that on case-insensitive filesystems one
+     * might get false positives for "use" (and "require"):
+     * "use Strict" or "require CARP" will work.  This causes
+     * portability problems for the script: in case-strict
+     * filesystems the script will stop working.
+     *
+     * The "incorrect case" warning checked whether "use Foo"
+     * imported "Foo" to your namespace, but that is wrong, too:
+     * there is no requirement nor promise in the language that
+     * a Foo.pm should or would contain anything in package "Foo".
+     *
+     * There is very little Configure-wise that can be done, either:
+     * the case-sensitivity of the build filesystem of Perl does not
+     * help in guessing the case-sensitivity of the runtime environment.
+     */
 
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
@@ -3658,7 +3643,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	}
 	curop = list(force_list(left));
 	o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
-	o->op_private = 0 | (flags >> 8);
+	o->op_private = (U8)(0 | (flags >> 8));
 	for (curop = ((LISTOP*)curop)->op_first;
 	     curop; curop = curop->op_sibling)
 	{
@@ -3675,7 +3660,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
 		    if (curop->op_type == OP_GV) {
 			GV *gv = cGVOPx_gv(curop);
-			if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+			if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
 			    break;
 			SvCUR(gv) = PL_generation;
 		    }
@@ -3685,7 +3670,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			     curop->op_type == OP_PADANY) {
 			SV **svp = AvARRAY(PL_comppad_name);
 			SV *sv = svp[curop->op_targ];
-			if (SvCUR(sv) == PL_generation)
+			if ((int)SvCUR(sv) == PL_generation)
 			    break;
 			SvCUR(sv) = PL_generation;	/* (SvCUR not used any more) */
 		    }
@@ -3705,7 +3690,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 #else
 			    GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
 #endif
-			    if (gv == PL_defgv || SvCUR(gv) == PL_generation)
+			    if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
 				break;
 			    SvCUR(gv) = PL_generation;
 			}
@@ -3796,8 +3781,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	cop->op_type = OP_NEXTSTATE;
 	cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
-    cop->op_flags = flags;
-    cop->op_private = (PL_hints & HINT_PRIVATE_MASK);
+    cop->op_flags = (U8)flags;
+    cop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
@@ -3914,12 +3899,6 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	    return first;
 	}
     }
-    else if (first->op_type == OP_WANTARRAY) {
-	if (type == OP_AND)
-	    list(other);
-	else
-	    scalar(other);
-    }
     else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS)) {
 	OP *k1 = ((UNOP*)first)->op_first;
 	OP *k2 = k1->op_sibling;
@@ -3942,7 +3921,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 		  || k1->op_type == OP_EACH)
 	    {
 		warnop = ((k1->op_type == OP_NULL)
-			  ? k1->op_targ : k1->op_type);
+			  ? (OPCODE)k1->op_targ : k1->op_type);
 	    }
 	    break;
 	}
@@ -3966,12 +3945,12 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     NewOp(1101, logop, 1, LOGOP);
 
-    logop->op_type = type;
+    logop->op_type = (OPCODE)type;
     logop->op_ppaddr = PL_ppaddr[type];
     logop->op_first = first;
     logop->op_flags = flags | OPf_KIDS;
     logop->op_other = LINKLIST(other);
-    logop->op_private = 1 | (flags >> 8);
+    logop->op_private = (U8)(1 | (flags >> 8));
 
     /* establish postfix order */
     logop->op_next = LINKLIST(first);
@@ -3998,6 +3977,10 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 
     scalarboolean(first);
     if (first->op_type == OP_CONST) {
+        if (first->op_private & OPpCONST_BARE &&
+           first->op_private & OPpCONST_STRICT) {
+           no_bareword_allowed(first);
+       }
 	if (SvTRUE(((SVOP*)first)->op_sv)) {
 	    op_free(first);
 	    op_free(falseop);
@@ -4009,16 +3992,12 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 	    return falseop;
 	}
     }
-    else if (first->op_type == OP_WANTARRAY) {
-	list(trueop);
-	scalar(falseop);
-    }
     NewOp(1101, logop, 1, LOGOP);
     logop->op_type = OP_COND_EXPR;
     logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
     logop->op_first = first;
     logop->op_flags = flags | OPf_KIDS;
-    logop->op_private = 1 | (flags >> 8);
+    logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);
 
@@ -4054,7 +4033,7 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
     range->op_flags = OPf_KIDS;
     leftstart = LINKLIST(left);
     range->op_other = LINKLIST(right);
-    range->op_private = 1 | (flags >> 8);
+    range->op_private = (U8)(1 | (flags >> 8));
 
     left->op_sibling = right;
 
@@ -4187,7 +4166,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 	    next = unstack;
 	cont = append_elem(OP_LINESEQ, cont, unstack);
 	if ((line_t)whileline != NOLINE) {
-	    PL_copline = whileline;
+	    PL_copline = (line_t)whileline;
 	    cont = append_elem(OP_LINESEQ, cont,
 			       newSTATEOP(0, Nullch, Nullop));
 	}
@@ -4197,7 +4176,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
     redo = LINKLIST(listop);
 
     if (expr) {
-	PL_copline = whileline;
+	PL_copline = (line_t)whileline;
 	scalar(listop);
 	o = new_logop(OP_AND, 0, &expr, &listop);
 	if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
@@ -4241,7 +4220,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo
 {
     LOOP *loop;
     OP *wop;
-    int padoff = 0;
+    PADOFFSET padoff = 0;
     I32 iterflags = 0;
 
     if (sv) {
@@ -4359,6 +4338,10 @@ 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));
@@ -4394,13 +4377,14 @@ 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))
-	SvREFCNT_dec(CvOUTSIDE(cv));
+        freecv = outsidecv;
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4409,10 +4393,40 @@ Perl_cv_undef(pTHX_ CV *cv)
     if (CvPADLIST(cv)) {
 	/* may be during global destruction */
 	if (SvREFCNT(CvPADLIST(cv))) {
-	    I32 i = AvFILLp(CvPADLIST(cv));
-	    while (i >= 0) {
-		SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
-		SV* sv = svp ? *svp : Nullsv;
+	    AV *padlist = CvPADLIST(cv);
+	    I32 ix;
+	    /* pads may be cleared out already during global destruction */
+	    if (is_eval && !PL_dirty) {
+		/* 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) == '&'
+			&& ix <= AvFILLp(comppad))
+		    {
+			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--];
 		if (!sv)
 		    continue;
 		if (sv == (SV*)PL_comppad_name)
@@ -4427,6 +4441,8 @@ Perl_cv_undef(pTHX_ CV *cv)
 	}
 	CvPADLIST(cv) = Nullav;
     }
+    else if (freecv)
+	SvREFCNT_dec(freecv);
     if (CvXSUB(cv)) {
         CvXSUB(cv) = 0;
     }
@@ -5115,7 +5131,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    call_list(oldscope, PL_beginav);
 
 	    PL_curcop = &PL_compiling;
-	    PL_compiling.op_private = PL_hints;
+	    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 	    LEAVE;
 	}
 	else if (strEQ(s, "END") && !PL_error_count) {
@@ -5524,7 +5540,7 @@ Perl_ck_anoncode(pTHX_ OP *o)
 OP *
 Perl_ck_bitop(pTHX_ OP *o)
 {
-    o->op_private = PL_hints;
+    o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
     return o;
 }