7 use Test::Leaner 'no_plan';
9 use Scope::Upper qw<unwind HERE SCOPE>;
11 # @_[0 .. $#_] also ought to work, but it sometimes evaluates to nonsense in
12 # scalar context on perl 5.8.5 and below.
14 sub list { wantarray ? @_ : $_[$#_] }
30 [ 'scalar(', ')', 's' ],
31 [ 'list(', ')', 'l' ],
34 sub linearize { join ', ', map { defined($_) ? $_ : '(undef)' } @_ }
39 # Don't put closures in empty pads on 5.6.
42 my $capture_outer_pad = "$]" < 5.008 ? "++\$dummy;" : '';
46 for my $block (@blocks) {
47 for my $context (@contexts) {
48 my $source = <<"FRAME";
50 my \$next = shift; $capture_outer_pad
52 unshift \@stack, HERE;
54 (\@{shift \@pre}, \$next->[0]->(\@_))
68 die "$err. Source was :\n$source\n" if $@;
70 push @test_frames, [ $code, $source, $context->[2] ];
78 unwind(@_ => $stack[$depth]);
79 }, 'target context from HERE' ],
82 unwind(@_ => SCOPE($depth == 0 ? 0 : (2 * ($depth - 1) + 1)));
83 }, 'target context from SCOPE' ],
88 for my $args ([ ], [ 'A' ], [ qw<B C> ]) {
90 for my $frame0 (@test_frames) {
91 for my $frame1 (@test_frames) {
92 for my $frame2 (@test_frames) {
94 $seed += 5; # Coprime with $max_depth
96 for (1 .. $max_depth) {
99 my $l = $seed % $max_depth - 1;
100 push @prepend, [ $i .. ($i + $l) ];
102 my $prepend_str = join ' ', map { '[' . join(' ', @$_) . ']' } @prepend;
103 for my $depth (0 .. $max_depth) {
105 my @cxts = map $_->[2], $frame0, $frame1, $frame2;
107 for (my $i = $depth + 1; $i <= $max_depth; ++$i) {
108 my $c = $cxts[$max_depth - $i];
111 } elsif ($c eq 's') {
112 @exp = @exp ? $exp[-1] : undef;
114 unshift @exp, @{$prepend[$max_depth - $i]};
119 for my $target (@targets) {
121 local @pre = @prepend;
122 my @res = $frame0->[0]->($frame1, $frame2, $target, @args, $depth);
123 my $got = linearize @res;
126 === This testcase failed ===
131 ==== vvvvv Errors vvvvvv ===
134 is $got, $exp, "unwind to depth $depth with args [@args] and prepending $prepend_str";