From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 9 Oct 1999 00:41:02 +0000 (+0000)
Subject: POPSUB() gave up the refcount to the CV before LEAVE had a chance to
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b0d9ce3858aa1d5f16f24f50ca1172e6eb75fcd9;p=p5sagit%2Fp5-mst-13.2.git

POPSUB() gave up the refcount to the CV before LEAVE had a chance to
clear entries in the CV's pad, leading to coredumps when CV had no
other references to it; this is a slightly edited version of the
patch suggested by Russel O'Connor <roconnor@world.std.com>

p4raw-id: //depot/perl@4321
---

diff --git a/cop.h b/cop.h
index 88749fb..457aeb4 100644
--- a/cop.h
+++ b/cop.h
@@ -62,7 +62,8 @@ struct block_sub {
     } STMT_END
 #endif /* USE_THREADS */
 
-#define POPSUB(cx)							\
+#define POPSUB(cx,sv)							\
+    STMT_START {							\
 	if (cx->blk_sub.hasargs) {					\
 	    POPSAVEARRAY();						\
 	    /* abandon @_ if it got reified */				\
@@ -75,10 +76,16 @@ struct block_sub {
 		PL_curpad[0] = (SV*)cx->blk_sub.argarray;		\
 	    }								\
 	}								\
-	if (cx->blk_sub.cv) {						\
-	    if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))	\
-		SvREFCNT_dec(cx->blk_sub.cv);				\
-	}
+	sv = (SV*)cx->blk_sub.cv;					\
+	if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth))		\
+	    sv = Nullsv;						\
+    } STMT_END
+
+#define LEAVESUB(sv)							\
+    STMT_START {							\
+	if (sv)								\
+	    SvREFCNT_dec(sv);						\
+    } STMT_END
 
 #define POPFORMAT(cx)							\
 	setdefout(cx->blk_sub.dfoutgv);					\
diff --git a/pp_ctl.c b/pp_ctl.c
index 746cb80..3bf4f1d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1187,6 +1187,7 @@ Perl_dounwind(pTHX_ I32 cxix)
     I32 optype;
 
     while (cxstack_ix > cxix) {
+	SV *sv;
 	cx = &cxstack[cxstack_ix];
 	DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
 			      (long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
@@ -1196,7 +1197,8 @@ Perl_dounwind(pTHX_ I32 cxix)
 	    POPSUBST(cx);
 	    continue;  /* not break */
 	case CXt_SUB:
-	    POPSUB(cx);
+	    POPSUB(cx,sv);
+	    LEAVESUB(sv);
 	    break;
 	case CXt_EVAL:
 	    POPEVAL(cx);
@@ -1700,6 +1702,7 @@ PP(pp_return)
     SV **newsp;
     PMOP *newpm;
     I32 optype = 0;
+    SV *sv;
 
     if (PL_curstackinfo->si_type == PERLSI_SORT) {
 	if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) {
@@ -1771,11 +1774,14 @@ PP(pp_return)
 
     /* Stack values are safe: */
     if (popsub2) {
-	POPSUB(cx);	/* release CV and @_ ... */
+	POPSUB(cx,sv);	/* release CV and @_ ... */
     }
+    else
+	sv = Nullsv;
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVE;
+    LEAVESUB(sv);
     return pop_return();
 }
 
@@ -1791,6 +1797,7 @@ PP(pp_last)
     SV **newsp;
     PMOP *newpm;
     SV **mark;
+    SV *sv = Nullsv;
 
     if (PL_op->op_flags & OPf_SPECIAL) {
 	cxix = dopoptoloop(cxstack_ix);
@@ -1850,12 +1857,13 @@ PP(pp_last)
 	LEAVE;
 	break;
     case CXt_SUB:
-	POPSUB(cx);	/* release CV and @_ ... */
+	POPSUB(cx,sv);	/* release CV and @_ ... */
 	break;
     }
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVE;
+    LEAVESUB(sv);
     return nextop;
 }
 
diff --git a/pp_hot.c b/pp_hot.c
index 90e8f5f..78a454c 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1914,6 +1914,7 @@ PP(pp_leavesub)
     PMOP *newpm;
     I32 gimme;
     register PERL_CONTEXT *cx;
+    SV *sv;
 
     POPBLOCK(cx,newpm);
  
@@ -1951,10 +1952,11 @@ PP(pp_leavesub)
     }
     PUTBACK;
     
-    POPSUB(cx);		/* Stack values are safe: release CV and @_ ... */
+    POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVE;
+    LEAVESUB(sv);
     return pop_return();
 }
 
@@ -1968,6 +1970,7 @@ PP(pp_leavesublv)
     PMOP *newpm;
     I32 gimme;
     register PERL_CONTEXT *cx;
+    SV *sv;
 
     POPBLOCK(cx,newpm);
  
@@ -2005,8 +2008,10 @@ PP(pp_leavesublv)
 	 * the refcounts so the caller gets a live guy. Cannot set
 	 * TEMP, so sv_2mortal is out of question. */
 	if (!CvLVALUE(cx->blk_sub.cv)) {
-	    POPSUB(cx);
+	    POPSUB(cx,sv);
 	    PL_curpm = newpm;
+	    LEAVE;
+	    LEAVESUB(sv);
 	    DIE(aTHX_ "Can't modify non-lvalue subroutine call");
 	}
 	if (gimme == G_SCALAR) {
@@ -2014,8 +2019,10 @@ PP(pp_leavesublv)
 	    EXTEND_MORTAL(1);
 	    if (MARK == SP) {
 		if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
-		    POPSUB(cx);
+		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
+		    LEAVE;
+		    LEAVESUB(sv);
 		    DIE(aTHX_ "Can't return a %s from lvalue subroutine",
 			SvREADONLY(TOPs) ? "readonly value" : "temporary");
 		}
@@ -2026,8 +2033,10 @@ PP(pp_leavesublv)
 		}
 	    }
 	    else {			/* Should not happen? */
-		POPSUB(cx);
+		POPSUB(cx,sv);
 		PL_curpm = newpm;
+		LEAVE;
+		LEAVESUB(sv);
 		DIE(aTHX_ "%s returned from lvalue subroutine in scalar context",
 		    (MARK > SP ? "Empty array" : "Array"));
 	    }
@@ -2039,8 +2048,10 @@ PP(pp_leavesublv)
 		if (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
 		    /* Might be flattened array after $#array =  */
 		    PUTBACK;
-		    POPSUB(cx);
+		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
+		    LEAVE;
+		    LEAVESUB(sv);
 		    DIE(aTHX_ "Can't return %s from lvalue subroutine",
 			(*mark != &PL_sv_undef)
 			? (SvREADONLY(TOPs)
@@ -2093,10 +2104,11 @@ PP(pp_leavesublv)
     }
     PUTBACK;
     
-    POPSUB(cx);		/* Stack values are safe: release CV and @_ ... */
+    POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVE;
+    LEAVESUB(sv);
     return pop_return();
 }