From: Dave Mitchell <davem@fdisolutions.com>
Date: Sat, 21 May 2005 19:15:43 +0000 (+0000)
Subject: disallow eval { goto &foo }
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c74ace89800a81a764294e9f6eacc04bbed5a568;p=p5sagit%2Fp5-mst-13.2.git

disallow eval { goto &foo }
eval 'goto &foo' is already banned, and the try-version usually
coredumps due to the code assuming the CxEVAL is actually a CxSUB.
Anyway exiting an eval but preserving "it's" @_ doesn't make much
sense.

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

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index de1d496..fce62b5 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -752,11 +752,10 @@ a block, except that it isn't a proper block.  This usually occurs if
 you tried to jump out of a sort() block or subroutine, which is a no-no.
 See L<perlfunc/goto>.
 
-=item Can't goto subroutine from an eval-string
+=item Can't goto subroutine from an eval-%s
 
 (F) The "goto subroutine" call can't be used to jump out of an eval
-"string".  (You can use it to jump out of an eval {BLOCK}, but you
-probably don't want to.)
+"string" or block.
 
 =item Can't goto subroutine outside a subroutine
 
diff --git a/pp_ctl.c b/pp_ctl.c
index ae25cc6..4dc0046 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2297,8 +2297,11 @@ PP(pp_goto)
 	    if (cxix < cxstack_ix)
 		dounwind(cxix);
 	    TOPBLOCK(cx);
-	    if (CxREALEVAL(cx))
-		DIE(aTHX_ "Can't goto subroutine from an eval-string");
+	    if (CxTYPE(cx) == CXt_EVAL)
+		if (CxREALEVAL(cx))
+		    DIE(aTHX_ "Can't goto subroutine from an eval-string");
+		else
+		    DIE(aTHX_ "Can't goto subroutine from an eval-block");
 	    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
 		/* put @_ back onto stack */
 		AV* av = cx->blk_sub.argarray;
diff --git a/t/op/goto.t b/t/op/goto.t
index ac3e489..7f502bd 100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 54;
+plan tests => 56;
 
 our $foo;
 while ($?) {
@@ -428,4 +428,11 @@ a32039();
     is($r, "ok", 'redo and goto');
 }
 
+# goto &foo not allowed in evals
 
+
+sub null { 1 };
+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');