File: skipme.t

package info (click to toggle)
libdevel-backtrace-perl 0.12-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 180 kB
  • sloc: perl: 541; makefile: 7
file content (93 lines) | stat: -r--r--r-- 2,236 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
#!/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";
    }
}