6 use Test::More tests => 38;
8 use Scope::Upper qw/reap UP HERE/;
21 is $x, 2, 'goto 1 [not yet - x]';
22 is $y, undef, 'goto 1 [not yet - y]';
30 is $x, 1, 'goto 1 [ok - x]';
31 is $y, 1, 'goto 1 [ok - y]';
42 reap \&check => UP UP;
44 is $x, 3, 'goto 2 [not yet - x]';
45 is $y, undef, 'goto 2 [not yet - y]';
54 is $x, 1, 'goto 2 [ok - x]';
55 is $y, 1, 'goto 2 [ok - y]';
67 reap \&check => UP UP UP;
68 is $x, 3, 'die - reap outside eval [not yet 1 - x]';
69 is $y, undef, 'die - reap outside eval [not yet 1 - y]';
71 is $x, 2, 'die - reap outside eval [not yet 2 - x]';
72 is $y, undef, 'die - reap outside eval [not yet 2 - y]';
76 is $x, 1, 'die - reap outside eval [not yet 3 - x]';
77 is $y, undef, 'die - reap outside eval [not yet 3 - y]';
78 } # should trigger here
79 is $x, 1, 'die - reap outside eval [ok - x]';
80 is $y, 1, 'die - reap outside eval [ok - y]';
91 reap \&check => UP UP;
92 is $x, 3, 'die - reap at eval [not yet 1 - x]';
93 is $y, undef, 'die - reap at eval [not yet 1 - y]';
95 is $x, 2, 'die - reap at eval [not yet 2 - x]';
96 is $y, undef, 'die - reap at eval [not yet 2 - y]';
99 }; # should trigger here
100 is $x, 1, 'die - reap at eval [ok - x]';
101 is $y, 1, 'die - reap at eval [ok - y]';
113 is $x, 3, 'die - reap inside eval [not yet 1 - x]';
114 is $y, undef, 'die - reap inside eval [not yet 1 - y]';
116 is $x, 2, 'die - reap inside eval [not yet 2 - x]';
117 is $y, undef, 'die - reap inside eval [not yet 2 - y]';
119 } # should trigger here
121 is $x, 1, 'die - reap inside eval [ok - x]';
122 is $y, 1, 'die - reap inside eval [ok - y]';
132 reap { ++$y; die "reaped\n" } => HERE;
133 is $x, 3, 'die in reap at eval [not yet - x]';
134 is $y, undef, 'die in reap at eval [not yet - y]';
135 }; # should trigger here, but the die isn't catched by this eval
138 is $@, "reaped\n", 'die in reap at eval [ok - $@]';
139 is $x, 1, 'die in reap at eval [ok - x]';
140 is $y, 1, 'die in reap at Eval [ok - y]';
150 reap { ++$y; die "reaped\n" } => HERE;
151 is $x, 3, 'die in reap inside eval [not yet - x]';
152 is $y, undef, 'die in reap inside eval [not yet - y]';
153 } # should trigger here
156 is $@, "reaped\n", 'die in reap inside eval [ok - $@]';
157 is $x, 1, 'die in reap inside eval [ok - x]';
158 is $y, 1, 'die in reap inside eval [ok - y]';