]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/15-reap-multi.t
Fix goto &xsub in uplevel
[perl/modules/Scope-Upper.git] / t / 15-reap-multi.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 8 + 18 + 4 + 8 + 11 + 5 + 17;
7
8 use Scope::Upper qw<reap UP HERE>;
9
10 my $x;
11
12 sub add { local $_; my $y = $_[0]; reap sub { $x += $y } => $_[1] }
13
14 $x = 0;
15 {
16  is($x, 0, 'start');
17  {
18   add 1 => HERE;
19   is($x, 0, '1 didn\'t run');
20   {
21    add 2 => HERE;
22    is($x, 0, '1 and 2 didn\'t run');
23   }
24   is($x, 2, '1 didn\'t run, 2 ran');
25   {
26    add 4 => HERE;
27    is($x, 2, '1 and 3 didn\'t run, 2 ran');
28   }
29   is($x, 6, '1 didn\'t run, 2 and 3 ran');
30  }
31  is($x, 7, '1, 2 and 3 ran');
32 }
33 is($x, 7, 'end');
34
35 $x = 0;
36 {
37  is($x, 0, 'start');
38  local $_ = 3;
39  is($_, 3, '$_ has the right value');
40  {
41   add 1 => HERE;
42   is($_, 3, '$_ has the right value');
43   local $_ = 5;
44   is($x, 0, '1 didn\'t run');
45   is($_, 5, '$_ has the right value');
46   {
47    add 2 => HERE;
48    is($_, 5, '$_ has the right value');
49    local $_ = 7;
50    is($_, 7, '$_ has the right value');
51    is($x, 0, '1 and 2 didn\'t run');
52   }
53   is($x, 2, '1 didn\'t run, 2 ran');
54   is($_, 5, '$_ has the right value');
55   {
56    local $_ = 9;
57    is($_, 9, '$_ has the right value');
58    add 4 => HERE;
59    local $_ = 11;
60    is($_, 11, '$_ has the right value');
61    is($x, 2, '1 and 3 didn\'t run, 2 ran');
62   }
63   is($x, 6, '1 didn\'t run, 2 and 3 ran');
64   is($_, 5, '$_ has the right value');
65  }
66  is($x, 7, '1, 2 and 3 ran');
67  is($_, 3, '$_ has the right value');
68 }
69 is($x, 7, 'end');
70
71 $x = 0;
72 {
73  is($x, 0, 'start');
74  {
75   add 1 => HERE;
76   add 2 => HERE;
77   is($x, 0, '1 and 2 didn\'t run');
78  }
79  is($x, 3, '1 and 2 ran');
80 }
81 is($x, 3, 'end');
82
83 $x = 0;
84 {
85  is($x, 0, 'start');
86  local $_ = 3;
87  {
88   local $_ = 5;
89   add 1 => HERE;
90   is($_, 5, '$_ has the right value');
91   local $_ = 7;
92   add 2 => HERE;
93   is($_, 7, '$_ has the right value');
94   is($x, 0, '1 and 2 didn\'t run');
95   local $_ = 9;
96   is($_, 9, '$_ has the right value');
97  }
98  is($x, 3, '1 and 2 ran');
99  is($_, 3, '$_ has the right value');
100 }
101 is($x, 3, 'end');
102
103 $x = 0;
104 {
105  is($x, 0, 'start');
106  {
107   {
108    add 1 => UP;
109    is($x, 0, '1 didn\'t run');
110   }
111   is($x, 0, '1 didn\'t run');
112  }
113  is($x, 1, '1 ran');
114  { 
115   {
116    {
117     add 2 => UP UP;
118     is($x, 1, '2 didn\'t run');
119    }
120    is($x, 1, '2 didn\'t run');
121    {
122     add 4 => UP;
123     is($x, 1, '2 and 3 didn\'t run');
124    }
125    is($x, 1, '2 and 3 didn\'t run');
126   }
127   is($x, 5, '2 didn\'t run, 3 ran');
128  }
129  is($x, 7, '2 and 3 ran');
130 }
131 is($x, 7, 'end');
132
133 sub bleh { add 2 => UP; }
134
135 $x = 0;
136 {
137  is($x, 0, 'start');
138  {
139   add 1 => HERE;
140   is($x, 0, '1 didn\'t run');
141   bleh();
142   is($x, 0, '1 didn\'t run');
143  }
144  is($x, 3, '1 ran');
145 }
146 is($x, 3, 'end');
147
148 sub bar {
149  is($_, 7, '$_ has the right value');
150  local $_ = 9;
151  add 4 => UP UP;
152  is($_, 9, '$_ has the right value');
153  add 8 => UP UP UP;
154  is($_, 9, '$_ has the right value');
155 }
156
157 sub foo {
158  local $_ = 7;
159  add 2 => HERE;
160  is($_, 7, '$_ has the right value');
161  is($x, 0, '1, 2 didn\'t run');
162  bar();
163  is($x, 0, '1, 2, 3, 4 didn\'t run');
164  is($_, 7, '$_ has the right value');
165  add 16 => UP;
166  is($_, 7, '$_ has the right value');
167 }
168
169 $x = 0;
170 {
171  is($x, 0, 'start');
172  local $_ = 3;
173  add 1 => HERE;
174  is($_, 3, '$_ has the right value');
175  {
176   local $_ = 5;
177   is($_, 5, '$_ has the right value');
178   is($x, 0, '1 didn\'t run');
179   {
180    foo();
181    is($x, 2, '1, 3, 4 and 5 didn\'t run, 2 ran');
182    is($_, 5, '$_ has the right value');
183   }
184   is($x, 22, '1 and 4 didn\'t run, 2, 3 and 5 ran');
185  }
186  is($x, 30, '1 didn\'t run, 2, 3, 4 and 5 ran');
187 }
188 is($x, 31, 'end');