From: Vincent Pit <perl@profvince.com>
Date: Wed, 22 Jul 2009 12:35:49 +0000 (+0200)
Subject: Teach goto how to cross given/when blocks
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bb5aedc13f30a9f0a65cc4c489b97a919d5d03a2;p=p5sagit%2Fp5-mst-13.2.git

Teach goto how to cross given/when blocks
---

diff --git a/pp_ctl.c b/pp_ctl.c
index ebfcf74..a8b8b6d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2624,6 +2624,8 @@ PP(pp_goto)
 	    case CXt_LOOP_LAZYSV:
 	    case CXt_LOOP_FOR:
 	    case CXt_LOOP_PLAIN:
+	    case CXt_GIVEN:
+	    case CXt_WHEN:
 		gotoprobe = cx->blk_oldcop->op_sibling;
 		break;
 	    case CXt_SUBST:
diff --git a/t/op/switch.t b/t/op/switch.t
index 2012c6c..dcec866 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan tests => 122;
+plan tests => 127;
 
 # The behaviour of the feature pragma should be tested by lib/switch.t
 # using the tests in t/lib/switch/*. This file tests the behaviour of
@@ -965,6 +965,56 @@ LETTER2: for ("a".."e") {
 }
 is($letter, "a,c,e,", "next LABEL in when");
 
+# Test goto with given/when
+{
+    my $flag = 0;
+    goto GIVEN1;
+    $flag = 1;
+    GIVEN1: given ($flag) {
+	when (0) { break; }
+	$flag = 2;
+    }
+    is($flag, 0, "goto GIVEN1");
+}
+{
+    my $flag = 0;
+    given ($flag) {
+	when (0) { $flag = 1; }
+	goto GIVEN2;
+	$flag = 2;
+    }
+GIVEN2:
+    is($flag, 1, "goto inside given");
+}
+{
+    my $flag = 0;
+    given ($flag) {
+	when (0) { $flag = 1; goto GIVEN3; $flag = 2; }
+	$flag = 3;
+    }
+GIVEN3:
+    is($flag, 1, "goto inside given and when");
+}
+{
+    my $flag = 0;
+    for ($flag) {
+	when (0) { $flag = 1; goto GIVEN4; $flag = 2; }
+	$flag = 3;
+    }
+GIVEN4:
+    is($flag, 1, "goto inside for and when");
+}
+{
+    my $flag = 0;
+GIVEN5:
+    given ($flag) {
+	when (0) { $flag = 1; goto GIVEN5; $flag = 2; }
+	when (1) { break; }
+	$flag = 3;
+    }
+    is($flag, 1, "goto inside given and when to the given stmt");
+}
+
 # Okay, that'll do for now. The intricacies of the smartmatch
 # semantics are tested in t/op/smartmatch.t
 __END__