]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blobdiff - t/55-unwind-multi.t
Make some room in test ordering
[perl/modules/Scope-Upper.git] / t / 55-unwind-multi.t
diff --git a/t/55-unwind-multi.t b/t/55-unwind-multi.t
deleted file mode 100644 (file)
index 07df3eb..0000000
+++ /dev/null
@@ -1,104 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-
-use Test::More tests => 13 + 3;
-
-use Scope::Upper qw<unwind SCOPE CALLER>;
-
-my ($l1, $l2);
-
-our $x;
-
-sub c {
- $x = 3;
- sub {
-  unwind("eval", eval {
-   do {
-    for (3, 4, 5) {
-     1, unwind('from', 'the', 'sub', 'c' => SCOPE $l1);
-    }
-   }
-  } => SCOPE $l2);
- }->(2, 3, 4);
- return 'in c'
-}
-
-sub b {
- local $x = 2;
- my @c = (1 .. 12, c());
- is $x, 3, '$x in b after c()';
- return @c, 'in b';
-}
-
-sub a {
- local $x = 1;
- my @b = b();
- is $x, 1, '$x in a after b()';
- return @b, 'in a';
-}
-
-$l1 = 0;
-$l2 = 0;
-is_deeply [ a() ], [ 1 .. 12, 'in c', 'in b', 'in a' ],
-          'l1=0, l2=0';
-
-$l1 = 0;
-$l2 = 1;
-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' ],
-          'l1=0, l2=2';
-
-$l1 = 4;
-$l2 = 999;
-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' ],
-          '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";
-}