]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/55-unwind-multi.t
Rename some variables and struct members around su_uplevel()
[perl/modules/Scope-Upper.git] / t / 55-unwind-multi.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 13 + 3;
7
8 use Scope::Upper qw<unwind SCOPE CALLER>;
9
10 my ($l1, $l2);
11
12 our $x;
13
14 sub c {
15  $x = 3;
16  sub {
17   unwind("eval", eval {
18    do {
19     for (3, 4, 5) {
20      1, unwind('from', 'the', 'sub', 'c' => SCOPE $l1);
21     }
22    }
23   } => SCOPE $l2);
24  }->(2, 3, 4);
25  return 'in c'
26 }
27
28 sub b {
29  local $x = 2;
30  my @c = (1 .. 12, c());
31  is $x, 3, '$x in b after c()';
32  return @c, 'in b';
33 }
34
35 sub a {
36  local $x = 1;
37  my @b = b();
38  is $x, 1, '$x in a after b()';
39  return @b, 'in a';
40 }
41
42 $l1 = 0;
43 $l2 = 0;
44 is_deeply [ a() ], [ 1 .. 12, 'in c', 'in b', 'in a' ],
45           'l1=0, l2=0';
46
47 $l1 = 0;
48 $l2 = 1;
49 is_deeply [ a() ], [ 1 .. 12, qw<eval from the sub c>, 'in b', 'in a' ],
50           'l1=0, l2=1';
51
52 $l1 = 0;
53 $l2 = 2;
54 is_deeply [ a() ], [ qw<eval from the sub c>, 'in a' ],
55           'l1=0, l2=2';
56
57 $l1 = 4;
58 $l2 = 999;
59 is_deeply [ a() ], [ 1 .. 12, qw<from the sub c>, 'in b', 'in a' ],
60           'l1=4, l2=?';
61
62 $l1 = 5;
63 $l2 = 999;
64 is_deeply [ a() ], [ qw<from the sub c>, 'in a' ],
65           'l1=5, l2=?';
66
67 # Unwinding while unwinding
68 {
69  package Scope::Upper::TestGuard;
70
71  sub new {
72   my $class = shift;
73   bless { cb => $_[0] }, $class;
74  }
75
76  sub DESTROY {
77   $_[0]->{cb}->()
78  }
79 }
80
81 {
82  my $desc = 'unwinding while unwinding';
83  local $@;
84
85  eval {
86   my @res = sub {
87    sub {
88     my $guard = Scope::Upper::TestGuard->new(sub {
89      my @res = sub {
90       sub {
91        unwind @_ => CALLER(1);
92       }->(@_);
93       fail "$desc (second): not reached";
94      }->(qw<a b c>);
95      is_deeply \@res, [ qw<a b c> ], "$desc (second): correct returned values";
96     });
97     unwind @_ => CALLER(1);
98    }->(@_);
99    fail "$desc (first): not reached";
100   }->(qw<y z>);
101   is_deeply \@res, [ qw<y z> ], "$desc (first): correct returned values";
102  };
103  is $@, '', "$desc: did not croak";
104 }