From: Dave Mitchell <davem@fdisolutions.com>
Date: Sun, 17 Jul 2005 20:12:54 +0000 (+0000)
Subject: $SIG{__WARN__} = sub { goto &foo } could recurse infinitely
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c5be5b4d0dbe0afabce77a95841bf101893b1571;p=p5sagit%2Fp5-mst-13.2.git

$SIG{__WARN__} = sub { goto &foo } could recurse infinitely

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

diff --git a/t/op/goto.t b/t/op/goto.t
index 7f502bd..082a165 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 56;
+plan tests => 57;
 
 our $foo;
 while ($?) {
@@ -436,3 +436,13 @@ eval 'goto &null';
 like($@, qr/Can't goto subroutine from an eval-string/, 'eval string');
 eval { goto &null };
 like($@, qr/Can't goto subroutine from an eval-block/, 'eval block');
+
+# [perl #36521] goto &foo in warn handler could defeat recursion avoider
+
+{
+    my $r = runperl(
+		stderr => 1,
+		prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);'
+    );
+    like($r, qr/bar/, "goto &foo in warn");
+}
diff --git a/util.c b/util.c
index 74f5944..4f1a8e8 100644
--- a/util.c
+++ b/util.c
@@ -1278,6 +1278,8 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
 	    SV *msg;
 
 	    ENTER;
+	    SAVESPTR(PL_warnhook);
+	    PL_warnhook = Nullsv;
 	    save_re_context();
 	    msg = newSVpvn(message, msglen);
 	    SvFLAGS(msg) |= utf8;