Prevent simple uplevel argument tests from reifying @_

[perl/modules/Scope-Upper.git] / t / 55-unwind-multi.t

diff --git a/t/55-unwind-multi.t b/t/55-unwind-multi.t
index dd8c727393197fd3873028128951e5f4e9644d41..07df3ebdc153cd55329e0b8cf793d9abe74976d2 100644 (file)
--- a/t/55-unwind-multi.t
+++ b/t/55-unwind-multi.t
@@ -3,9 +3,9 @@
 use strict;
 use warnings;
 
-use Test::More tests => 13;
+use Test::More tests => 13 + 3;
 
-use Scope::Upper qw/unwind SCOPE/;
+use Scope::Upper qw<unwind SCOPE CALLER>;
 
 my ($l1, $l2);
 
@@ -46,20 +46,59 @@ is_deeply [ a() ], [ 1 .. 12, 'in c', 'in b', 'in a' ],
 
 $l1 = 0;
 $l2 = 1;
-is_deeply [ a() ], [ 1 .. 12, qw/eval from the sub c/, 'in b', 'in a' ],
+is_deeply [ a() ], [ 1 .. 12, qw<eval from the sub c>, 'in b', 'in a' ],
           'l1=0, l2=1';
 
 $l1 = 0;
 $l2 = 2;
-is_deeply [ a() ], [ qw/eval from the sub c/, 'in a' ],
+is_deeply [ a() ], [ qw<eval from the sub c>, 'in a' ],
           'l1=0, l2=2';
 
 $l1 = 4;
 $l2 = 999;
-is_deeply [ a() ], [ 1 .. 12, qw/from the sub c/, 'in b', 'in a' ],
+is_deeply [ a() ], [ 1 .. 12, qw<from the sub c>, 'in b', 'in a' ],
           'l1=4, l2=?';
 
 $l1 = 5;
 $l2 = 999;
-is_deeply [ a() ], [ qw/from the sub c/, 'in a' ],
+is_deeply [ a() ], [ qw<from the sub c>, 'in a' ],
           'l1=5, l2=?';
+
+# Unwinding while unwinding
+{
+ package Scope::Upper::TestGuard;
+
+ sub new {
+  my $class = shift;
+  bless { cb => $_[0] }, $class;
+ }
+
+ sub DESTROY {
+  $_[0]->{cb}->()
+ }
+}
+
+{
+ my $desc = 'unwinding while unwinding';
+ local $@;
+
+ eval {
+  my @res = sub {
+   sub {
+    my $guard = Scope::Upper::TestGuard->new(sub {
+     my @res = sub {
+      sub {
+       unwind @_ => CALLER(1);
+      }->(@_);
+      fail "$desc (second): not reached";
+     }->(qw<a b c>);
+     is_deeply \@res, [ qw<a b c> ], "$desc (second): correct returned values";
+    });
+    unwind @_ => CALLER(1);
+   }->(@_);
+   fail "$desc (first): not reached";
+  }->(qw<y z>);
+  is_deeply \@res, [ qw<y z> ], "$desc (first): correct returned values";
+ };
+ is $@, '', "$desc: did not croak";
+}