From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 13 Oct 1998 03:32:02 +0000 (+0000)
Subject: defer "deep recursion" warnings until CXt_SUB context is properly
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4a925ff6e0a016ce4f2615607e10674d0b0eb2ef;p=p5sagit%2Fp5-mst-13.2.git

defer "deep recursion" warnings until CXt_SUB context is properly
set up

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

diff --git a/pp_hot.c b/pp_hot.c
index f513c12..859dcfb 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2281,9 +2281,6 @@ PP(pp_entersub)
 	if (CvDEPTH(cv) < 2)
 	    (void)SvREFCNT_inc(cv);
 	else {	/* save temporaries on recursion? */
-	    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
-		  && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
-		sub_crush_depth(cv);
 	    if (CvDEPTH(cv) > AvFILLp(padlist)) {
 		AV *av;
 		AV *newpad = newAV();
@@ -2383,6 +2380,13 @@ PP(pp_entersub)
 		MARK++;
 	    }
 	}
+	/* warning must come *after* we fully set up the context
+	 * stuff so that __WARN__ handlers can safely dounwind()
+	 * if they want to
+	 */
+	if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
+	    && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+	    sub_crush_depth(cv);
 #if 0
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(),
 			      "%p entersub returning %p\n", thr, CvSTART(cv)));
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index ab18094..c78b266 100644
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -90,10 +90,14 @@ sub fred
 { 
     fred() if $a++ < 200
 } 
-
-fred()
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
 EXPECT
-Deep recursion on subroutine "main::fred" at - line 5.
+ok
 ########
 # pp_hot.c
 use warning 'recursion' ;