]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/65-uplevel-multi.t
Make sure the code snippets fit in 80-columns wide terminal
[perl/modules/Scope-Upper.git] / t / 65-uplevel-multi.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 3 + 7 * 2 + 8;
7
8 use Scope::Upper qw<uplevel HERE UP>;
9
10 sub depth {
11  my $depth = 0;
12  while (1) {
13   my @c = caller($depth);
14   last unless @c;
15   ++$depth;
16  }
17  return $depth - 1;
18 }
19
20 is depth(),                           0, 'check top depth';
21 is sub { depth() }->(),               1, 'check subroutine call depth';
22 is do { local $@; eval { depth() } }, 1, 'check eval block depth';
23
24 {
25  my $desc = 'uplevel in uplevel : lower frame';
26  local $@;
27  my @ret = eval {
28   1, sub {
29    is depth(), 2, "$desc: correct depth 1";
30    2, uplevel(sub {
31     is depth(), 2, "$desc: correct depth 2";
32     3, sub {
33      is depth(), 3, "$desc: correct depth 3";
34      4, uplevel(sub {
35       is depth(), 3, "$desc: correct depth 4";
36       return 5, @_;
37      }, 6, @_, HERE);
38     }->(7, @_);
39    }, 8, @_, HERE);
40   }->(9);
41  };
42  is $@,      '',              "$desc: no error";
43  is depth(), 0,               "$desc: correct depth outside";
44  is_deeply \@ret, [ 1 .. 9 ], "$desc: correct return value"
45 }
46
47 {
48  my $desc = 'uplevel in uplevel : same frame';
49  local $@;
50  my @ret = eval {
51   11, sub {
52    is depth(), 2, "$desc: correct depth 1";
53    12, uplevel(sub {
54     is depth(), 2, "$desc: correct depth 2";
55     13, sub {
56      is depth(), 3, "$desc: correct depth 3";
57      14, uplevel(sub {
58       is depth(), 2, "$desc: correct depth 4";
59       return 15, @_;
60      }, 16, @_, UP);
61     }->(17, @_);
62    }, 18, @_, HERE);
63   }->(19);
64  };
65  is $@,      '',                "$desc: no error";
66  is depth(), 0,                 "$desc: correct depth outside";
67  is_deeply \@ret, [ 11 .. 19 ], "$desc: correct return value"
68 }
69
70 {
71  my $desc = 'uplevel in uplevel : higher frame';
72  local $@;
73  my @ret = eval {
74   20, sub {
75    is depth(), 2, "$desc: correct depth 1";
76    21, sub {
77     is depth(), 3, "$desc: correct depth 2";
78     22, uplevel(sub {
79      is depth(), 3, "$desc: correct depth 3";
80      23, sub {
81       is depth(), 4, "$desc: correct depth 4";
82       24, uplevel(sub {
83        is depth(), 2, "$desc: correct depth 5";
84        return 25, @_;
85       }, 26, @_, UP UP);
86      }->(27, @_);
87     }, 28, @_, HERE);
88    }->(29, @_);
89   }->('2A');
90  };
91  is $@,      '',                      "$desc: no error";
92  is depth(), 0,                       "$desc: correct depth outside";
93  is_deeply \@ret, [ 20 .. 29, '2A' ], "$desc: correct return value"
94 }