6 use Test::More tests => 4 * 3 + 1 + 3;
11 use Scope::Upper qw<yield leave HERE>;
13 # Test timely destruction of values returned from yield()
16 sub guard { VPIT::TestHelpers::Guard->new(sub { ++$destroyed }) }
19 my $desc = 'scalar context, above';
24 is $destroyed, undef, "$desc: not yet destroyed 1";
28 is $destroyed, undef, "$desc: not yet destroyed 2";
30 is $destroyed, 1, "$desc: destroyed 1";
34 my $desc = 'scalar context, below';
39 is $destroyed, undef, "$desc: not yet destroyed 1";
43 is $destroyed, undef, "$desc: not yet destroyed 2";
45 is $destroyed, 1, "$desc: destroyed 1";
49 my $desc = 'void context, above';
54 is $destroyed, undef, "$desc: not yet destroyed 1";
58 is $destroyed, undef, "$desc: not yet destroyed 2";
60 is $destroyed, 1, "$desc: destroyed 1";
64 my $desc = 'void context, below';
68 is $destroyed, undef, "$desc: not yet destroyed 1";
73 is $destroyed, 1, "$desc: destroyed 1";
75 is $destroyed, 1, "$desc: destroyed 2";
78 # Test 'return from do' in special cases
84 my $thing = (777, do {
85 my @stuff = (888, do {
87 map { my $x; $_ x 3 } qw<x y z>
103 is "@res", '1 2 3 4', 'yield() found the op to return to';
113 is "@res", '1 2', 'leave without arguments';
121 is "@res", '1 2 3 4', 'leave with arguments';
125 skip '"eval { $str =~ s/./die q[foo]/e }" breaks havoc on perl 5.8 and below'
126 => 1 if "$]" < 5.010;
130 $s =~ s/./leave; die 'not reached'/e;
133 my $line = __LINE__-3;
135 qr/^leave\(\) can't target a substitution context at \Q$0\E line $line/,
136 'leave() cannot exit subst';