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