7 use Test::Leaner 'no_plan';
9 use Scope::Upper qw<unwind UP HERE>;
11 our ($call, @args, $args);
14 my ($height, $level, $i) = @_;
15 $level = $level ? 'UP ' x $level : 'HERE';
16 return [ [ "unwind(\@args => $level)\n", '' ] ];
32 @blocks = map [ map "$_\n", @$_ ], @blocks;
33 @contexts = map [ map "$_\n", @$_ ], @contexts;
36 my ($height, $level, $i) = @_;
37 push @_, $i = 0 if @_ == 2;
39 my $up = $i == $height + 1 ? $call->(@_) : gen($height, $level, $i + 1);
40 if ($i + $level == $height + 1) {
42 $_->[1] = "return($args)\n";
46 my ($code, $exp) = @$base;
47 for my $blk (@blocks) {
48 for my $cx (@contexts) {
50 $blk->[0] . $cx->[0] . $code . $cx->[1] . $blk->[1],
51 $blk->[0] . $cx->[0] . $exp . $cx->[1] . $blk->[1],
53 my $list = join ', ', map { int rand 10 } 0 .. rand 3;
55 $blk->[0] . $cx->[0] . "($list, " . $code . ')' . $cx->[1] . $blk->[1],
56 $blk->[0] . $cx->[0] . "($list, " . $exp . ')' . $cx->[1] . $blk->[1],
64 sub linearize { join ', ', map { defined($_) ? $_ : '(undef)' } @_ }
67 my ($height, $level) = @_;
73 my $res = linearize eval $_->[0];
74 $res = '*TEST DID NOT COMPILE*' if $@;
77 $exp = linearize eval $_->[1];
78 $exp = '*REFERENCE DID NOT COMPILE*' if $@;
80 if ($@ || $res ne $exp) {
82 === This testcase failed ===
84 ==== vvvvv Errors vvvvvv ===
87 is $res, $exp, "stress unwind $height $level $i";
91 for ([ ], [ 'A' ], [ qw<B C> ]) {
93 $args = '(' . join(', ', map "'$_'", @args) . ')';