don't crash on deep recursion warnings in lexical subs (#118521)
authorLukas Mai <l.mai@web.de>
Tue, 18 Jun 2013 07:51:32 +0000 (09:51 +0200)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 18 Jun 2013 13:22:08 +0000 (06:22 -0700)
pp_hot.c
t/op/lexsub.t

index e19776b..c493d40 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2895,8 +2895,15 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     if (CvANON(cv))
        Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
     else {
-       SV* const tmpstr = sv_newmortal();
-       gv_efullname3(tmpstr, CvGV(cv), NULL);
+        HEK *const hek = CvNAME_HEK(cv);
+        SV *tmpstr;
+        if (hek) {
+            tmpstr = sv_2mortal(newSVhek(hek));
+        }
+        else {
+            tmpstr = sv_newmortal();
+            gv_efullname3(tmpstr, CvGV(cv), NULL);
+        }
        Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
                    SVfARG(tmpstr));
     }
index d70f2cc..27b6de7 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     *bar::like = *like;
 }
 no warnings 'deprecated';
-plan 134;
+plan 135;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -695,3 +695,11 @@ eval 'sub not_lexical7 { my @x }';
     }
   }
 }
+
+like runperl(
+      switches => [ '-Mfeature=:all', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
+      prog     => 'my sub foo; sub foo { foo } foo',
+      stderr   => 1
+     ),
+     qr/Deep recursion on subroutine "foo"/,
+    'deep recursion warnings for lexical subs do not crash';