view release on metacpan or  search on metacpan

t/caller.t  view on Meta::CPAN

#!/usr/local/bin/perl -w

use Test;
use strict;

my $has_diff = eval "use Test::Differences; 1";

sub flatten {  ## In case !$has_diff
    join( "",
        map(
            "[" . join( ",", map defined $_ ? "'$_'" : "undef", @$_ ) . "]\n",
            shift()
        )
    );
}


sub aok {
    if ( $has_diff ) {
        goto &eq_or_diff;
    }
    else {
        @_ = (
            flatten( $_[0] ),
            flatten( $_[1] ),
            @_[2..$#_],
        );
        goto &ok;
    }
}


use Carp;

## This next bit needs to be compiled twice, once before we use
## Devel::TraceCalls and once after.
sub compile_stack_checker {
    eval <<'END' or die $@;
$^W = 0;  ## No redeclared warnings
use strict;
sub stack {
    my ( $context ) = @_;
    my @s;
    my $i = 0;
    while (1) {
        my @c ;
        if ( $context eq "scalar" ) {
            $c[0] = caller $i;
        }
        else {
            push @c, caller $i;
        }
        ++$i;
        last unless $c[0];
        my $j = 0;
        @c =
            map "depth " . $i . "[" . $j++ . "]: $_",
            map { s/\(eval \d+\)/(eval <<number>>)/g; $_ }
            map defined() ? $_ : "<<undef>>",
            @c;
#warn join ",", @c;
        push @s, @c;
    }
    return @s;
}