ACIL FM

Pilih semua

Nama	Ukuran	Aksi
lib	-	Open
00-report-prereqs.dd	2.65 MB	View DL Edit
00-report-prereqs.t	5.45 MB	View DL Edit
01_die_check.t	458 B	View DL Edit
02_uplevel.t	4.46 MB	View DL Edit
03_nested_uplevels.t	1.64 MB	View DL Edit
04_honor_later_override.t	2.28 MB	View DL Edit
05_honor_prior_override.t	2.58 MB	View DL Edit
06_db_args.t	545 B	View DL Edit
07_uplevel_too_high.t	720 B	View DL Edit
08_exporter.t	310 B	View DL Edit
09_emptylist.t	516 B	View DL Edit

Edit file: /home/.cpan/build/Sub-Uplevel-0.2800-0/t/03_nested_uplevels.t

#!/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]" );
}

Batal

Isi Zip:

Create