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
97
|
#!/usr/bin/perl
use strict;
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: {
my $has_st = eval "require Devel::StackTrace" || 0;
skip("Devel::StackTrace not installed", 1) unless $has_st;
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");
}
|
