From: Vincent Pit <vince@profvince.com>
Date: Mon, 19 Sep 2011 21:31:22 +0000 (+0200)
Subject: Test that goto-to-uplevel does not mess up returned values
X-Git-Tag: v0.17~4
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=8afcc751a1eb6d635f6a1a015711ecc674072a38

Test that goto-to-uplevel does not mess up returned values
---

diff --git a/t/62-uplevel-return.t b/t/62-uplevel-return.t
index 1271de3..ff4df57 100644
--- a/t/62-uplevel-return.t
+++ b/t/62-uplevel-return.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => (13 + 5 + 4) * 2 + 1 + (3 + 3 + 1) + 11;
+use Test::More tests => (13 + 5 + 4) * 2 + 1 + (3 + 3 + 1) + 2 + 11;
 
 use Scope::Upper qw<uplevel HERE UP>;
 
@@ -149,6 +149,30 @@ for my $run (1 .. 3) {
  is_deeply \@ret, [ qw|< ( A B [ { * } ] Z ) >| ], "$desc: outside";
 }
 
+# goto
+
+SKIP: {
+ skip "goto to an uplevel'd stack frame does not work on perl 5\.6"
+                                                           => 2 if "$]" < 5.008;
+
+ {
+  my $desc = 'values returned from goto';
+  local $@;
+  my $cb  = sub { 'hello' };
+  my @ret = eval {
+   'a', sub {
+    'b', sub {
+     'c', &uplevel(sub {
+       'd', (goto $cb), 'w'
+     } => UP), 'x'
+    }->(), 'y'
+   }->(), 'z'
+  };
+  is        $@,    '',                        "$desc: did not croak";
+  is_deeply \@ret, [ qw<a b c hello x y z> ], "$desc: returned values";
+ }
+}
+
 # Magic
 
 {