Add ENTER_with_name and LEAVE_with_name to automaticly check for matching ENTER/LEAVE when debugging is enabled

10 files changed, 130 insertions, 86 deletions

diff --git a/embedvar.h b/embedvar.h
index 0ed7d38dd9..e805a79822 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -265,6 +265,7 @@
 #define PL_scopestack		(vTHX->Iscopestack)
 #define PL_scopestack_ix	(vTHX->Iscopestack_ix)
 #define PL_scopestack_max	(vTHX->Iscopestack_max)
+#define PL_scopestack_name	(vTHX->Iscopestack_name)
 #define PL_screamfirst		(vTHX->Iscreamfirst)
 #define PL_screamnext		(vTHX->Iscreamnext)
 #define PL_secondgv		(vTHX->Isecondgv)
@@ -581,6 +582,7 @@
 #define PL_Iscopestack		PL_scopestack
 #define PL_Iscopestack_ix	PL_scopestack_ix
 #define PL_Iscopestack_max	PL_scopestack_max
+#define PL_Iscopestack_name	PL_scopestack_name
 #define PL_Iscreamfirst		PL_screamfirst
 #define PL_Iscreamnext		PL_screamnext
 #define PL_Isecondgv		PL_secondgv
diff --git a/intrpvar.h b/intrpvar.h
index 10cd6b7d34..20df3050f3 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -43,6 +43,9 @@ PERLVAR(Istack_base,	SV **)
 PERLVAR(Istack_max,	SV **)
 
 PERLVAR(Iscopestack,	I32 *)		/* scopes we've ENTERed */
+#ifdef DEBUGGING
+PERLVAR(Iscopestack_name, const char * *) /* name of the scopes we've ENTERed */
+#endif
 PERLVAR(Iscopestack_ix,	I32)
 PERLVAR(Iscopestack_max,I32)
 
diff --git a/perl.c b/perl.c
index 64ab7319d1..3ffd3fc9e9 100644
--- a/perl.c
+++ b/perl.c
@@ -3813,6 +3813,9 @@ Perl_init_stacks(pTHX)
     SET_MARK_OFFSET;
 
     Newx(PL_scopestack,REASONABLE(32),I32);
+#ifdef DEBUGGING
+    Newx(PL_scopestack_name,REASONABLE(32),const char*);
+#endif
     PL_scopestack_ix = 0;
     PL_scopestack_max = REASONABLE(32);
 
diff --git a/perlapi.h b/perlapi.h
index ff2a278ed9..5c2df7429b 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -566,6 +566,8 @@ END_EXTERN_C
 #define PL_scopestack_ix	(*Perl_Iscopestack_ix_ptr(aTHX))
 #undef  PL_scopestack_max
 #define PL_scopestack_max	(*Perl_Iscopestack_max_ptr(aTHX))
+#undef  PL_scopestack_name
+#define PL_scopestack_name	(*Perl_Iscopestack_name_ptr(aTHX))
 #undef  PL_screamfirst
 #define PL_screamfirst		(*Perl_Iscreamfirst_ptr(aTHX))
 #undef  PL_screamnext
diff --git a/pp.c b/pp.c
index 67a2d1167d..4b6d11faca 100644
--- a/pp.c
+++ b/pp.c
@@ -4523,9 +4523,9 @@ PP(pp_splice)
 	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_SPLICE");
 	call_method("SPLICE",GIMME_V);
-	LEAVE;
+	LEAVE_with_name("call_SPLICE");
 	SPAGAIN;
 	RETURN;
     }
@@ -4719,9 +4719,9 @@ PP(pp_push)
 	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_PUSH");
 	call_method("PUSH",G_SCALAR|G_DISCARD);
-	LEAVE;
+	LEAVE_with_name("call_PUSH");
 	SPAGAIN;
     }
     else {
@@ -4768,9 +4768,9 @@ PP(pp_unshift)
 	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_UNSHIFT");
 	call_method("UNSHIFT",G_SCALAR|G_DISCARD);
-	LEAVE;
+	LEAVE_with_name("call_UNSHIFT");
 	SPAGAIN;
     }
     else {
@@ -5330,9 +5330,9 @@ PP(pp_split)
 	}
 	else {
 	    PUTBACK;
-	    ENTER;
+	    ENTER_with_name("call_PUSH");
 	    call_method("PUSH",G_SCALAR|G_DISCARD);
-	    LEAVE;
+	    LEAVE_with_name("call_PUSH");
 	    SPAGAIN;
 	    if (gimme == G_ARRAY) {
 		I32 i;
diff --git a/pp_ctl.c b/pp_ctl.c
index 06a0f7389a..921363fe97 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -996,14 +996,14 @@ PP(pp_grepstart)
     PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
     pp_pushmark();				/* push dst */
     pp_pushmark();				/* push src */
-    ENTER;					/* enter outer scope */
+    ENTER_with_name("grep");					/* enter outer scope */
 
     SAVETMPS;
     if (PL_op->op_private & OPpGREP_LEX)
 	SAVESPTR(PAD_SVl(PL_op->op_targ));
     else
 	SAVE_DEFSV;
-    ENTER;					/* enter inner scope */
+    ENTER_with_name("grep_item");					/* enter inner scope */
     SAVEVPTR(PL_curpm);
 
     src = PL_stack_base[*PL_markstack_ptr];
@@ -1084,13 +1084,13 @@ PP(pp_mapwhile)
 	    }
 	}
     }
-    LEAVE;					/* exit inner scope */
+    LEAVE_with_name("grep_item");					/* exit inner scope */
 
     /* All done yet? */
     if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
 
 	(void)POPMARK;				/* pop top */
-	LEAVE;					/* exit outer scope */
+	LEAVE_with_name("grep");					/* exit outer scope */
 	(void)POPMARK;				/* pop src */
 	items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
 	(void)POPMARK;				/* pop dst */
@@ -1113,7 +1113,7 @@ PP(pp_mapwhile)
     else {
 	SV *src;
 
-	ENTER;					/* enter inner scope */
+	ENTER_with_name("grep_item");					/* enter inner scope */
 	SAVEVPTR(PL_curpm);
 
 	/* set $_ to the new source item */
@@ -1858,7 +1858,7 @@ PP(pp_dbstate)
 	    /* don't do recursive DB::DB call */
 	    return NORMAL;
 
-	ENTER;
+	ENTER_with_name("sub");
 	SAVETMPS;
 
 	SAVEI32(PL_debug);
@@ -1873,7 +1873,7 @@ PP(pp_dbstate)
 	    (void)(*CvXSUB(cv))(aTHX_ cv);
 	    CvDEPTH(cv)--;
 	    FREETMPS;
-	    LEAVE;
+	    LEAVE_with_name("sub");
 	    return NORMAL;
 	}
 	else {
@@ -1901,7 +1901,7 @@ PP(pp_enteriter)
     PAD *iterdata;
 #endif
 
-    ENTER;
+    ENTER_with_name("loop1");
     SAVETMPS;
 
     if (PL_op->op_targ) {
@@ -1930,7 +1930,7 @@ PP(pp_enteriter)
     if (PL_op->op_private & OPpITER_DEF)
 	cxtype |= CXp_FOR_DEF;
 
-    ENTER;
+    ENTER_with_name("loop2");
 
     PUSHBLOCK(cx, cxtype, SP);
 #ifdef USE_ITHREADS
@@ -2027,9 +2027,9 @@ PP(pp_enterloop)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
-    ENTER;
+    ENTER_with_name("loop1");
     SAVETMPS;
-    ENTER;
+    ENTER_with_name("loop2");
 
     PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
     PUSHLOOP_PLAIN(cx, SP);
@@ -2072,8 +2072,8 @@ PP(pp_leaveloop)
     POPLOOP(cx);	/* Stack values are safe: release loop vars ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
-    LEAVE;
-    LEAVE;
+    LEAVE_with_name("loop2");
+    LEAVE_with_name("loop1");
 
     return NORMAL;
 }
@@ -2534,7 +2534,7 @@ PP(pp_goto)
 		PUSHMARK(mark);
 		PUTBACK;
 		(void)(*CvXSUB(cv))(aTHX_ cv);
-		LEAVE;
+		LEAVE_with_name("sub");
 		return retop;
 	    }
 	    else {
@@ -2872,7 +2872,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 
     PERL_ARGS_ASSERT_SV_COMPILE_2OP;
 
-    ENTER;
+    ENTER_with_name("eval");
     lex_start(sv, NULL, FALSE);
     SAVETMPS;
     /* switch to eval mode */
@@ -2933,7 +2933,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     lex_end();
     /* XXX DAPM do this properly one year */
     *padp = MUTABLE_AV(SvREFCNT_inc_simple(PL_comppad));
-    LEAVE;
+    LEAVE_with_name("eval");
     if (IN_PERL_COMPILETIME)
 	CopHINTS_set(&PL_compiling, PL_hints);
 #ifdef OP_IN_REGISTER
@@ -3071,7 +3071,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	    POPEVAL(cx);
 	}
 	lex_end();
-	LEAVE; /* pp_entereval knows about this LEAVE.  */
+	LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE.  */
 
 	msg = SvPVx_nolen_const(ERRSV);
 	if (optype == OP_REQUIRE) {
@@ -3277,9 +3277,9 @@ PP(pp_require)
 		vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
 	    SV *const importsv = vnormal(sv);
 	    *SvPVX_mutable(importsv) = ':';
-	    ENTER;
+	    ENTER_with_name("load_feature");
 	    Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
-	    LEAVE;
+	    LEAVE_with_name("load_feature");
 	}
 	/* If a version >= 5.11.0 is requested, strictures are on by default! */
 	if (PL_compcv &&
@@ -3362,7 +3362,7 @@ PP(pp_require)
 		    tryname = SvPVX_const(namesv);
 		    tryrsfp = NULL;
 
-		    ENTER;
+		    ENTER_with_name("call_INC");
 		    SAVETMPS;
 		    EXTEND(SP, 2);
 
@@ -3440,7 +3440,7 @@ PP(pp_require)
 
 		    PUTBACK;
 		    FREETMPS;
-		    LEAVE;
+		    LEAVE_with_name("call_INC");
 
 		    if (tryrsfp) {
 			hook_sv = dirsv;
@@ -3587,7 +3587,7 @@ PP(pp_require)
 			   unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 );
     }
 
-    ENTER;
+    ENTER_with_name("eval");
     SAVETMPS;
     lex_start(NULL, tryrsfp, TRUE);
 
@@ -3674,7 +3674,7 @@ PP(pp_entereval)
     TAINT_IF(SvTAINTED(sv));
     TAINT_PROPER("eval");
 
-    ENTER;
+    ENTER_with_name("eval");
     lex_start(sv, NULL, FALSE);
     SAVETMPS;
 
@@ -3818,7 +3818,7 @@ PP(pp_leaveeval)
 	/* die_where() did LEAVE, or we won't be here */
     }
     else {
-	LEAVE;
+	LEAVE_with_name("eval");
 	if (!(save_flags & OPf_SPECIAL)) {
 	    CLEAR_ERRSV();
 	}
@@ -3841,7 +3841,7 @@ Perl_delete_eval_scope(pTHX)
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
     PL_curpm = newpm;
-    LEAVE;
+    LEAVE_with_name("eval_scope");
     PERL_UNUSED_VAR(newsp);
     PERL_UNUSED_VAR(gimme);
     PERL_UNUSED_VAR(optype);
@@ -3855,7 +3855,7 @@ Perl_create_eval_scope(pTHX_ U32 flags)
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 	
-    ENTER;
+    ENTER_with_name("eval_scope");
     SAVETMPS;
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
@@ -3923,7 +3923,7 @@ PP(pp_leavetry)
     }
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
-    LEAVE;
+    LEAVE_with_name("eval_scope");
     CLEAR_ERRSV();
     RETURN;
 }
@@ -3934,7 +3934,7 @@ PP(pp_entergiven)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     
-    ENTER;
+    ENTER_with_name("given");
     SAVETMPS;
 
     sv_setsv(PAD_SV(PL_op->op_targ), POPs);
@@ -3962,7 +3962,7 @@ PP(pp_leavegiven)
 
     PL_curpm = newpm;   /* pop $1 et al */
 
-    LEAVE;
+    LEAVE_with_name("given");
 
     return NORMAL;
 }
@@ -3979,7 +3979,7 @@ S_make_matcher(pTHX_ REGEXP *re)
     PM_SETRE(matcher, ReREFCNT_inc(re));
 
     SAVEFREEOP((OP *) matcher);
-    ENTER; SAVETMPS;
+    ENTER_with_name("matcher"); SAVETMPS;
     SAVEOP();
     return matcher;
 }
@@ -4009,7 +4009,7 @@ S_destroy_matcher(pTHX_ PMOP *matcher)
     PERL_UNUSED_ARG(matcher);
 
     FREETMPS;
-    LEAVE;
+    LEAVE_with_name("matcher");
 }
 
 /* Do a smart match */
@@ -4096,7 +4096,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 		RETPUSHYES;
 	    while ( (he = hv_iternext(hv)) ) {
 		DEBUG_M(Perl_deb(aTHX_ "        testing hash key...\n"));
-		ENTER;
+		ENTER_with_name("smartmatch_hash_key_test");
 		SAVETMPS;
 		PUSHMARK(SP);
 		PUSHs(hv_iterkeysv(he));
@@ -4108,7 +4108,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 		else
 		    andedresults = SvTRUEx(POPs) && andedresults;
 		FREETMPS;
-		LEAVE;
+		LEAVE_with_name("smartmatch_hash_key_test");
 	    }
 	    if (andedresults)
 		RETPUSHYES;
@@ -4127,7 +4127,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	    for (i = 0; i <= len; ++i) {
 		SV * const * const svp = av_fetch(av, i, FALSE);
 		DEBUG_M(Perl_deb(aTHX_ "        testing array element...\n"));
-		ENTER;
+		ENTER_with_name("smartmatch_array_elem_test");
 		SAVETMPS;
 		PUSHMARK(SP);
 		if (svp)
@@ -4140,7 +4140,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 		else
 		    andedresults = SvTRUEx(POPs) && andedresults;
 		FREETMPS;
-		LEAVE;
+		LEAVE_with_name("smartmatch_array_elem_test");
 	    }
 	    if (andedresults)
 		RETPUSHYES;
@@ -4150,7 +4150,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	else {
 	  sm_any_sub:
 	    DEBUG_M(Perl_deb(aTHX_ "    applying rule Any-CodeRef\n"));
-	    ENTER;
+	    ENTER_with_name("smartmatch_coderef");
 	    SAVETMPS;
 	    PUSHMARK(SP);
 	    PUSHs(d);
@@ -4162,7 +4162,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	    else if (SvTEMP(TOPs))
 		SvREFCNT_inc_void(TOPs);
 	    FREETMPS;
-	    LEAVE;
+	    LEAVE_with_name("smartmatch_coderef");
 	    RETURN;
 	}
     }
@@ -4507,7 +4507,7 @@ PP(pp_enterwhen)
     if ((0 == (PL_op->op_flags & OPf_SPECIAL)) && !SvTRUEx(POPs))
 	return cLOGOP->op_other->op_next;
 
-    ENTER;
+    ENTER_with_name("eval");
     SAVETMPS;
 
     PUSHBLOCK(cx, CXt_WHEN, SP);
@@ -4532,7 +4532,7 @@ PP(pp_leavewhen)
 
     PL_curpm = newpm;   /* pop $1 et al */
 
-    LEAVE;
+    LEAVE_with_name("eval");
     return NORMAL;
 }
 
@@ -4919,7 +4919,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	dSP;
 	int count;
 
-	ENTER;
+	ENTER_with_name("call_filter_sub");
 	SAVE_DEFSV;
 	SAVETMPS;
 	EXTEND(SP, 2);
@@ -4943,7 +4943,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
 	PUTBACK;
 	FREETMPS;
-	LEAVE;
+	LEAVE_with_name("call_filter_sub");
     }
 
     if(SvOK(upstream)) {
diff --git a/pp_hot.c b/pp_hot.c
index 0730aff1a7..a74be213fa 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -157,7 +157,7 @@ PP(pp_sassign)
 	    /* We've been returned a constant rather than a full subroutine,
 	       but they expect a subroutine reference to apply.  */
 	    if (SvROK(cv)) {
-		ENTER;
+		ENTER_with_name("sassign_coderef");
 		SvREFCNT_inc_void(SvRV(cv));
 		/* newCONSTSUB takes a reference count on the passed in SV
 		   from us.  We set the name to NULL, otherwise we get into
@@ -167,7 +167,7 @@ PP(pp_sassign)
 		SvRV_set(left, MUTABLE_SV(newCONSTSUB(GvSTASH(right), NULL,
 						      SvRV(cv))));
 		SvREFCNT_dec(cv);
-		LEAVE;
+		LEAVE_with_name("sassign_coderef");
 	    } else {
 		/* What can happen for the corner case *{"BONK"} = \&{"BONK"};
 		   is that
@@ -719,14 +719,14 @@ PP(pp_print)
 	PUSHMARK(MARK - 1);
 	*MARK = SvTIED_obj(MUTABLE_SV(io), mg);
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_PRINT");
 	if( PL_op->op_type == OP_SAY ) {
 		/* local $\ = "\n" */
 		SAVEGENERICSV(PL_ors_sv);
 		PL_ors_sv = newSVpvs("\n");
 	}
 	call_method("PRINT", G_SCALAR);
-	LEAVE;
+	LEAVE_with_name("call_PRINT");
 	SPAGAIN;
 	MARK = ORIGMARK + 1;
 	*MARK = *SP;
@@ -1554,9 +1554,9 @@ Perl_do_readline(pTHX)
 	    PUSHMARK(SP);
 	    XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
 	    PUTBACK;
-	    ENTER;
+	    ENTER_with_name("call_READLINE");
 	    call_method("READLINE", gimme);
-	    LEAVE;
+	    LEAVE_with_name("call_READLINE");
 	    SPAGAIN;
 	    if (gimme == G_SCALAR) {
 		SV* const result = POPs;
@@ -1764,7 +1764,7 @@ PP(pp_enter)
 	    gimme = G_SCALAR;
     }
 
-    ENTER;
+    ENTER_with_name("block");
 
     SAVETMPS;
     PUSHBLOCK(cx, CXt_BLOCK, SP);
@@ -1891,7 +1891,7 @@ PP(pp_leave)
     }
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
-    LEAVE;
+    LEAVE_with_name("block");
 
     RETURN;
 }
@@ -2378,14 +2378,14 @@ PP(pp_grepwhile)
     if (SvTRUEx(POPs))
 	PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
     ++*PL_markstack_ptr;
-    LEAVE;					/* exit inner scope */
+    LEAVE_with_name("grep_item");					/* exit inner scope */
 
     /* All done yet? */
     if (PL_stack_base + *PL_markstack_ptr > SP) {
 	I32 items;
 	const I32 gimme = GIMME_V;
 
-	LEAVE;					/* exit outer scope */
+	LEAVE_with_name("grep");					/* exit outer scope */
 	(void)POPMARK;				/* pop src */
 	items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
 	(void)POPMARK;				/* pop dst */
@@ -2408,7 +2408,7 @@ PP(pp_grepwhile)
     else {
 	SV *src;
 
-	ENTER;					/* enter inner scope */
+	ENTER_with_name("grep_item");					/* enter inner scope */
 	SAVEVPTR(PL_curpm);
 
 	src = PL_stack_base[*PL_markstack_ptr];
@@ -2474,7 +2474,7 @@ PP(pp_leavesub)
     }
     PUTBACK;
 
-    LEAVE;
+    LEAVE_with_name("sub");
     cxstack_ix--;
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
@@ -2535,7 +2535,7 @@ 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)) {
-	    LEAVE;
+	    LEAVE_with_name("sub");
 	    cxstack_ix--;
 	    POPSUB(cx,sv);
 	    PL_curpm = newpm;
@@ -2550,7 +2550,7 @@ PP(pp_leavesublv)
 		 * of a tied hash or array */
 		if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
 		    !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
-		    LEAVE;
+		    LEAVE_with_name("sub");
 		    cxstack_ix--;
 		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
@@ -2566,7 +2566,7 @@ PP(pp_leavesublv)
 		}
 	    }
 	    else {			/* Should not happen? */
-		LEAVE;
+		LEAVE_with_name("sub");
 		cxstack_ix--;
 		POPSUB(cx,sv);
 		PL_curpm = newpm;
@@ -2583,7 +2583,7 @@ PP(pp_leavesublv)
 		    && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
 		    /* Might be flattened array after $#array =  */
 		    PUTBACK;
-		    LEAVE;
+		    LEAVE_with_name("sub");
 		    cxstack_ix--;
 		    POPSUB(cx,sv);
 		    PL_curpm = newpm;
@@ -2638,7 +2638,7 @@ PP(pp_leavesublv)
     }
     PUTBACK;
 
-    LEAVE;
+    LEAVE_with_name("sub");
     cxstack_ix--;
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
@@ -2668,7 +2668,7 @@ PP(pp_entersub)
 	    cv = sv_2cv(sv, &stash, &gv, 0);
 	}
 	if (!cv) {
-	    ENTER;
+	    ENTER_with_name("sub");
 	    SAVETMPS;
 	    goto try_autoload;
 	}
@@ -2722,7 +2722,7 @@ PP(pp_entersub)
 	break;
     }
 
-    ENTER;
+    ENTER_with_name("sub");
     SAVETMPS;
 
   retry:
@@ -2882,7 +2882,7 @@ try_autoload:
 		*(PL_stack_base + markix) = *PL_stack_sp;
 	    PL_stack_sp = PL_stack_base + markix;
 	}
-	LEAVE;
+	LEAVE_with_name("sub");
 	return NORMAL;
     }
 }
diff --git a/pp_sys.c b/pp_sys.c
index 80c59bc290..a985d658cd 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -318,13 +318,13 @@ PP(pp_backtick)
 		NOOP;
 	}
 	else if (gimme == G_SCALAR) {
-	    ENTER;
+	    ENTER_with_name("backtick");
 	    SAVESPTR(PL_rs);
 	    PL_rs = &PL_sv_undef;
 	    sv_setpvs(TARG, "");	/* note that this preserves previous buffer */
 	    while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
 		NOOP;
-	    LEAVE;
+	    LEAVE_with_name("backtick");
 	    XPUSHs(TARG);
 	    SvTAINTED_on(TARG);
 	}
@@ -364,7 +364,7 @@ PP(pp_glob)
      * without at the same time croaking, for some reason, or if
      * perl was built with PERL_EXTERNAL_GLOB */
 
-    ENTER;
+    ENTER_with_name("glob");
 
 #ifndef VMS
     if (PL_tainting) {
@@ -389,7 +389,7 @@ PP(pp_glob)
 #endif	/* !DOSISH */
 
     result = do_readline();
-    LEAVE;
+    LEAVE_with_name("glob");
     return result;
 }
 
@@ -534,9 +534,9 @@ PP(pp_open)
 	    *MARK-- = SvTIED_obj(MUTABLE_SV(io), mg);
 	    PUSHMARK(MARK);
 	    PUTBACK;
-	    ENTER;
+	    ENTER_with_name("call_OPEN");
 	    call_method("OPEN", G_SCALAR);
-	    LEAVE;
+	    LEAVE_with_name("call_OPEN");
 	    SPAGAIN;
 	    RETURN;
 	}
@@ -574,9 +574,9 @@ PP(pp_close)
 		PUSHMARK(SP);
 		XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
 		PUTBACK;
-		ENTER;
+		ENTER_with_name("call_CLOSE");
 		call_method("CLOSE", G_SCALAR);
-		LEAVE;
+		LEAVE_with_name("call_CLOSE");
 		SPAGAIN;
 		RETURN;
 	    }
@@ -665,9 +665,9 @@ PP(pp_fileno)
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
 	PUTBACK;
-	ENTER;
+	ENTER_with_name("call_FILENO");
 	call_method("FILENO", G_SCALAR);
-	LEAVE;
+	LEAVE_with_name("call_FILENO");
 	SPAGAIN;
 	RETURN;
     }
@@ -740,9 +740,9 @@ PP(pp_binmode)
 	    if (discp)
 		XPUSHs(discp);
 	    PUTBACK;
-	    ENTER;
+	    ENTER_with_name("call_BINMODE");
 	    call_method("BINMODE", G_SCALAR);
-	    LEAVE;
+	    LEAVE_with_name("call_BINMODE");
 	    SPAGAIN;
 	    RETURN;
 	}
@@ -820,7 +820,7 @@ PP(pp_tie)
     }
     items = SP - MARK++;
     if (sv_isobject(*MARK)) { /* Calls GET magic. */
-	ENTER;
+	ENTER_with_name("call_TIE");
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
 	EXTEND(SP,(I32)items);
@@ -840,7 +840,7 @@ PP(pp_tie)
 	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
 		 methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
 	}
-	ENTER;
+	ENTER_with_name("call_TIE");
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
 	EXTEND(SP,(I32)items);
@@ -863,7 +863,7 @@ PP(pp_tie)
 		       "Self-ties of arrays and hashes are not supported");
 	sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0);
     }
-    LEAVE;
+    LEAVE_with_name("call_TIE");
     SP = PL_stack_base + markoff;
     PUSHs(sv);
     RETURN;
@@ -890,9 +890,9 @@ PP(pp_untie)
 	       XPUSHs(SvTIED_obj(MUTABLE_SV(gv), mg));
 	       mXPUSHi(SvREFCNT(obj) - 1);
 	       PUTBACK;
-	       ENTER;
+	       ENTER_with_name("call_UNTIE");
 	       call_sv(MUTABLE_SV(cv), G_VOID);
-	       LEAVE;
+	       LEAVE_with_name("call_UNTIE");
 	       SPAGAIN;
             }
 	    else if (mg && SvREFCNT(obj) > 1) {
diff --git a/scope.c b/scope.c
index 1d5701e8b9..5da2554292 100644
--- a/scope.c
+++ b/scope.c
@@ -91,7 +91,13 @@ Perl_push_scope(pTHX)
     if (PL_scopestack_ix == PL_scopestack_max) {
 	PL_scopestack_max = GROW(PL_scopestack_max);
 	Renew(PL_scopestack, PL_scopestack_max, I32);
+#ifdef DEBUGGING
+	Renew(PL_scopestack_name, PL_scopestack_max, const char*);
+#endif DEBUGGING
     }
+#ifdef DEBUGGING
+    PL_scopestack_name[PL_scopestack_ix] = "unknown";
+#endif
     PL_scopestack[PL_scopestack_ix++] = PL_savestack_ix;
 
 }
diff --git a/scope.h b/scope.h
index 75177981d5..9fd3bce578 100644
--- a/scope.h
+++ b/scope.h
@@ -100,6 +100,20 @@ Opening bracket on a callback.  See C<LEAVE> and L<perlcall>.
 =for apidoc Ams||LEAVE
 Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 
+=over
+
+=item ENTER_with_name(name)
+
+Same as C<ENTER>, but when debugging is enabled it also associates the
+given literal string with the new scope.
+
+=item LEAVE_with_name(name)
+
+Same as C<LEAVE>, but when debugging is enabled it first checks that the
+scope has the given name. Name must be a literal string.
+
+=back
+
 =cut
 */
 
@@ -117,9 +131,23 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 	DEBUG_SCOPE("LEAVE")					\
 	pop_scope();						\
     } STMT_END
+#define ENTER_with_name(name)						\
+    STMT_START {							\
+	push_scope();							\
+	PL_scopestack_name[PL_scopestack_ix-1] = name;			\
+	DEBUG_SCOPE("ENTER \"" name "\"")				\
+    } STMT_END
+#define LEAVE_with_name(name)						\
+    STMT_START {							\
+	DEBUG_SCOPE("LEAVE \"" name "\"")				\
+	assert(strEQ(PL_scopestack_name[PL_scopestack_ix-1], name));	\
+	pop_scope();							\
+    } STMT_END
 #else
 #define ENTER push_scope()
 #define LEAVE pop_scope()
+#define ENTER_with_name(name) ENTER
+#define LEAVE_with_name(name) LEAVE
 #endif
 #define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)