1#!perl
2use strict;
3use Test::More;
4
5use Sub::Uplevel;
6
7package Wrap;
8use Sub::Uplevel;
9
10sub wrap {
11    my ($n, $f, $depth, $up, @case) = @_;
12    
13    if ($n > 1) {
14        $n--;
15        return wrap( $n, $f, $depth, $up, @case );
16    }
17    else {
18        return uplevel( $up , $f, $depth, $up, @case );
19    }
20}
21
22package Call;
23
24sub recurse_call_check {
25    my ($depth, $up, @case) = @_;
26
27    if ( $depth ) {
28        $depth--;
29        my @result;
30        push @result, recurse_call_check($depth, $up, @case, 'Call' );
31        for my $n ( 1 .. $up ) {
32            push @result, Wrap::wrap( $n, \&recurse_call_check, 
33                $depth, $n, @case, 
34                $n == 1 ? "Wrap(Call)" : "Wrap(Call) x $n" ),
35            ;
36        }
37        return @result;
38    }
39    else {
40        my (@uplevel_callstack, @real_callstack);
41        my $i = 0;
42        while ( defined( my $caller = caller($i++) ) ) {
43            push @uplevel_callstack, $caller;
44        }
45        $i = 0;
46        while ( defined( my $caller = CORE::caller($i++) ) ) {
47            push @real_callstack, $caller;
48        }
49        return [ 
50            join( q{, }, @case ),
51            join( q{, }, reverse @uplevel_callstack ),
52            join( q{, }, reverse @real_callstack ),
53        ];      
54    }
55}
56
57package main;
58
59my $depth = 4;
60my $up = 3;
61my $cases = 104;
62
63plan tests => $cases;
64
65my @results = Call::recurse_call_check( $depth, $up, 'Call' );
66
67is( scalar @results, $cases, 
68    "Right number of cases"
69);
70
71my $expected = shift @results;
72
73for my $got ( @results ) {
74    is( $got->[1], $expected->[1], 
75        "Case: $got->[0]"
76    ) or diag( "Real callers: $got->[2]" );
77}
78
79