#!/usr/bin/perl use strict; use warnings; use Devel::Backtrace; use Test::More tests => 8; Foo::foo1(); { package Foo; sub foo1 { foo2(); } sub foo2 { Bar::bar1(); } } { package Bar; sub bar1 { bar2(); } sub bar2 { Baz::baz1(); } } { package Baz; sub baz1 { baz2(); } sub baz2 { baz3(); } sub baz3 { my $backtrace = Devel::Backtrace->new; warn "pure backtrace: $backtrace" if $ENV{DEBUG}; # Tell Devel::Backtrace that we are not interested in what Baz method # calls which Baz method. $backtrace->skipme; warn "backtrace: $backtrace" if $ENV{DEBUG}; use Test::More; is(scalar($backtrace->points), 5, 'skipme count') or warn "skipme count: $backtrace"; is($backtrace->point(0)->subroutine, 'Baz::baz1', 'skipme') or warn "skipme: $backtrace"; my $backtrace2 = Devel::Backtrace->new; # Tell Devel::Backtrace that we are not even interested where the first # Baz method was called. $backtrace2->skipmysubs; is (scalar($backtrace2->points), 4, 'skipmysubs count') or warn "skipmysubs count: $backtrace"; is ($backtrace2->point(0)->subroutine, 'Bar::bar2', 'skipmysubs') or warn "skipmysubs: $backtrace"; warn "backtrace2: $backtrace2" if $ENV{DEBUG}; my $backtrace3 = Devel::Backtrace->new(1); $backtrace3->skipmysubs('Baz'); warn "backtrace3: $backtrace3" if $ENV{DEBUG}; is ($backtrace3->point(1)->to_string(-format => '%I'), 1, '%I') or warn "%I: $backtrace3"; is ($backtrace3->point(1)->_skip, 4, '_skip') or warn "_skip: $backtrace3"; is ($backtrace3->point(1)->to_string(-format => '%i'), 5, '%i') or warn "%i: $backtrace3"; # Same as above, but use -start instead of plain argument to new. my $backtrace4 = Devel::Backtrace->new(-start => 1); $backtrace4->skipmysubs('Baz'); is ($backtrace4->point(1)->_skip, 4, '_skip / -start') or warn "_skip / -start: $backtrace3 --\n$backtrace4"; } }