#!/usr/bin/perl

use strict;

BEGIN { $^W = 1 }

use Test::More;

use Sub::Uplevel;

package Wrap;

use Sub::Uplevel;

sub wrap {

    my ($n, $f, $depth, $up, @case) = @_;

    if ($n > 1) {

        $n--;

        return wrap( $n, $f, $depth, $up, @case );

    }

    else {

        return uplevel( $up , $f, $depth, $up, @case );

    }

}

package Call;

sub recurse_call_check {

    my ($depth, $up, @case) = @_;

    if ( $depth ) {

        $depth--;

        my @result;

        push @result, recurse_call_check($depth, $up, @case, 'Call' );

        for my $n ( 1 .. $up ) {

            push @result, Wrap::wrap( $n, \&recurse_call_check, 

                $depth, $n, @case, 

                $n == 1 ? "Wrap(Call)" : "Wrap(Call) x $n" ),

            ;

        }

        return @result;

    }

    else {

        my (@uplevel_callstack, @real_callstack);

        my $i = 0;

        while ( defined( my $caller = caller($i++) ) ) {

            push @uplevel_callstack, $caller;

        }

        $i = 0;

        while ( defined( my $caller = CORE::caller($i++) ) ) {

            push @real_callstack, $caller;

        }

        return [ 

            join( q{, }, @case ),

            join( q{, }, reverse @uplevel_callstack ),

            join( q{, }, reverse @real_callstack ),

        ];      

    }

}

package main;

my $depth = 4;

my $up = 3;

my $cases = 104;

plan tests => $cases;

my @results = Call::recurse_call_check( $depth, $up, 'Call' );

is( scalar @results, $cases, 

    "Right number of cases"

);

my $expected = shift @results;

for my $got ( @results ) {

    is( $got->[1], $expected->[1], 

        "Case: $got->[0]"

    ) or diag( "Real callers: $got->[2]" );

}