This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH for [ID 20010305.003]
authorRobin Houston <robin@cpan.org>
Wed, 14 Mar 2001 02:45:51 +0000 (02:45 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Wed, 14 Mar 2001 02:55:00 +0000 (02:55 +0000)
Message-ID: <20010314024551.A16207@puffinry.freeserve.co.uk>

p4raw-id: //depot/perl@9141

pp_ctl.c
t/op/eval.t

index 46e7ef0..99e3ff4 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2454,6 +2454,7 @@ PP(pp_goto)
 
     if (label && *label) {
        OP *gotoprobe = 0;
+       bool leaving_eval = FALSE;
 
        /* find label */
 
@@ -2463,6 +2464,7 @@ PP(pp_goto)
            cx = &cxstack[ix];
            switch (CxTYPE(cx)) {
            case CXt_EVAL:
+               leaving_eval = TRUE;
                 if (CxREALEVAL(cx)) {
                    gotoprobe = PL_eval_root; /* XXX not good for nested eval */
                    break;
@@ -2505,6 +2507,17 @@ PP(pp_goto)
        if (!retop)
            DIE(aTHX_ "Can't find label %s", label);
 
+       /* if we're leaving an eval, check before we pop any frames
+           that we're not going to punt, otherwise the error
+          won't be caught */
+
+       if (leaving_eval && *enterops && enterops[1]) {
+           I32 i;
+            for (i = 1; enterops[i]; i++)
+                if (enterops[i]->op_type == OP_ENTERITER)
+                    DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
+       }
+
        /* pop unwanted frames */
 
        if (ix < cxstack_ix) {
index 11fbfd0..f4d4be5 100755 (executable)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..40\n";
+print "1..41\n";
 
 eval 'print "ok 1\n";';
 
@@ -206,3 +206,18 @@ print $@;
     print "ok $x\n";
     $x++;
 }
+
+# Check that eval catches bad goto calls
+#   (BUG ID 20010305.003)
+{
+    eval {
+       eval { goto foo; };
+       print ($@ ? "ok 41\n" : "not ok 41\n");
+       last;
+       foreach my $i (1) {
+           foo: print "not ok 41\n";
+           print "# jumped into foreach\n";
+       }
+    };
+    print "not ok 41\n" if $@;
+}