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 (file)
--- 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 (file)
--- 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' ;