9 use Scope::Upper qw<uplevel HERE UP SUB CALLER>;
13 plan tests => 3 + $n * (6 + 3);
20 sub PI () { CORE::atan2(0, -1) }
25 my @c = caller($depth);
33 my ($depth, $top) = @_;
36 : $depth >= $top ? $top - 1
41 cap($shift + int($amp * sin(2 * PI * $_[0] / $period1)), 2 * $shift + 1);
45 my ($base_depth, $i) = @_;
47 my $h = int($base_depth / 2);
49 cap($h + int($h * sin(2 * PI * $i / $period2)), $base_depth);
53 my ($base_depth, $uplevel_depth, $desc, $i) = @_;
54 if ($i < $base_depth) {
55 $i, rec_basic($base_depth, $uplevel_depth, $desc, $i + 1);
57 is depth(), $base_depth+1, "$desc: depth before uplevel";
59 is depth(), $base_depth+1-$uplevel_depth, "$desc: depth inside uplevel";
60 is "@_", "$base_depth $uplevel_depth", "$desc: arguments";
62 } @_[0, 1], CALLER($uplevel_depth);
63 is depth(), $base_depth+1, "$desc: depth after uplevel";
69 my ($base_depth, $uplevel_depth, $desc, $i) = @_;
70 if ($i < $base_depth) {
75 rec_die($base_depth, $uplevel_depth, $desc, $i + 1)
79 rec_die($base_depth, $uplevel_depth, $desc, $i + 1)
88 my $n = $uplevel_depth;
95 is HERE, $cxt, "$desc: context inside uplevel";
102 my $die_line = __LINE__-6;
104 is depth(), 0, 'check top depth';
105 is sub { depth() }->(), 1, 'check subroutine call depth';
106 is do { local $@; eval { depth() } }, 1, 'check eval block depth';
108 for my $i (1 .. $n) {
109 my $base_depth = base_depth($i);
110 my $uplevel_depth = uplevel_depth($base_depth, $i);
113 my $desc = "basic $base_depth $uplevel_depth";
115 my @ret = rec_basic($base_depth, $uplevel_depth, $desc, 0);
116 is depth(), 0, "$desc: depth outside";
117 is_deeply \@ret, [ 0 .. $base_depth-1, -$uplevel_depth ],
118 "$desc: returned values";
123 my $desc = "die $base_depth $uplevel_depth";
125 my $err = rec_die($base_depth, $uplevel_depth, $desc, 0);
126 is depth(), 0, "$desc: depth outside";
127 like $err, qr/^XXX $base_depth $uplevel_depth at \Q$0\E line $die_line/,
128 "$desc: correct error";