File: 02_none.t

package info (click to toggle)
libtest-nowarnings-perl 1.06-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 156 kB
  • sloc: perl: 158; makefile: 2
file content (96 lines) | stat: -rw-r--r-- 2,300 bytes parent folder | download
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
94
95
96
use strict;
use warnings;
use Test::Tester;
use Test::More qw(no_plan);
use Test::NoWarnings qw( had_no_warnings warnings clear_warnings );

Test::NoWarnings::builder(Test::Tester::capture());

sub a {
    &b;
}

sub b {
    warn shift;
}

SCOPE: {
    check_test(
        sub {
            had_no_warnings("check warns");
        },
        {
            actual_ok => 1,
        },
        "no warns"
    );

    my ($prem, $result) = check_test(
        sub {
            a("hello there");
            had_no_warnings("check warns");
        },
        {
            actual_ok => 0,
        },
        "1 warn"
    );

    like($result->{diag}, '/^There were 1 warning\\(s\\)/', "1 warn diag");
    like($result->{diag}, "/Previous test 0 ''/", "1 warn diag test num");
    like($result->{diag}, '/hello there/', "1 warn diag has warn");

    my ($warn) = warnings();

    # 5.8.5 changed Carp's behaviour when the string ends in a \n
    # the monkey business is because 5.005 throws a "used only
    # once" warning for $Carp::VERSION
    my $cv   = do { no warnings; $Carp::VERSION };
    my $base = $cv >= 1.03;
    my @carp = split("\n", $warn->getCarp);

    like($carp[$base+1], '/main::b/', "carp level b");
    like($carp[$base+2], '/main::a/', "carp level a");

    SKIP: {
        eval { require Devel::StackTrace }
          or skip("Devel::StackTrace not installed", 1);

        isa_ok($warn->getTrace, "Devel::StackTrace");
    }
}

SCOPE: {
    clear_warnings();
    check_test(
        sub {
            had_no_warnings("check warns");
        },
        {
            actual_ok => 1,
        },
        "clear warns"
    );

    my ($prem, $empty_result, $result) = check_tests(
        sub {
            had_no_warnings("check warns empty");
            warn "hello once";
            warn "hello twice";
            had_no_warnings("check warns");
        },
        [
            {
                actual_ok => 1,
            },
            {
                actual_ok => 0,
            },
        ],
        "2 warn"
    );

    like($result->{diag}, '/^There were 2 warning\\(s\\)/', "2 warn diag");
    like($result->{diag}, "/Previous test 1 'check warns empty'/", "2 warn diag test num");
    like($result->{diag}, '/hello once.*hello twice/s', "2 warn diag has warn");
}