line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::NoWarnings; |
2
|
|
|
|
|
|
|
|
3
|
77
|
|
|
77
|
|
183996
|
use 5.006; |
|
77
|
|
|
|
|
256
|
|
4
|
77
|
|
|
77
|
|
440
|
use strict; |
|
77
|
|
|
|
|
128
|
|
|
77
|
|
|
|
|
1726
|
|
5
|
77
|
|
|
77
|
|
360
|
use warnings; |
|
77
|
|
|
|
|
149
|
|
|
77
|
|
|
|
|
2264
|
|
6
|
|
|
|
|
|
|
|
7
|
77
|
|
|
77
|
|
378
|
use Carp (); |
|
77
|
|
|
|
|
146
|
|
|
77
|
|
|
|
|
2084
|
|
8
|
77
|
|
|
77
|
|
410
|
use Exporter (); |
|
77
|
|
|
|
|
147
|
|
|
77
|
|
|
|
|
1418
|
|
9
|
77
|
|
|
77
|
|
403
|
use Test::Builder (); |
|
77
|
|
|
|
|
162
|
|
|
77
|
|
|
|
|
1837
|
|
10
|
77
|
|
|
77
|
|
27892
|
use Test::NoWarnings::Warning (); |
|
77
|
|
|
|
|
169
|
|
|
77
|
|
|
|
|
2190
|
|
11
|
|
|
|
|
|
|
|
12
|
77
|
|
|
77
|
|
380
|
use vars qw( $VERSION @EXPORT_OK @ISA $do_end_test ); |
|
77
|
|
|
|
|
127
|
|
|
77
|
|
|
|
|
6166
|
|
13
|
|
|
|
|
|
|
BEGIN { |
14
|
77
|
|
|
77
|
|
214
|
$VERSION = '1.02'; |
15
|
77
|
|
|
|
|
1786
|
@ISA = 'Exporter'; |
16
|
77
|
|
|
|
|
309
|
@EXPORT_OK = qw( |
17
|
|
|
|
|
|
|
clear_warnings had_no_warnings warnings |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Do we add the warning test at the end? |
21
|
77
|
|
|
|
|
41609
|
$do_end_test = 0; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $TEST = Test::Builder->new; |
25
|
|
|
|
|
|
|
my $PID = $$; |
26
|
|
|
|
|
|
|
my @WARNINGS = (); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
$SIG{__WARN__} = make_catcher(\@WARNINGS); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub import { |
31
|
77
|
|
|
77
|
|
522
|
$do_end_test = 1; |
32
|
77
|
|
|
|
|
109762
|
goto &Exporter::import; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# the END block must be after the "use Test::Builder" to make sure it runs |
36
|
|
|
|
|
|
|
# before Test::Builder's end block |
37
|
|
|
|
|
|
|
# only run the test if there have been other tests |
38
|
|
|
|
|
|
|
END { |
39
|
77
|
50
|
|
77
|
|
4877948
|
had_no_warnings() if $do_end_test; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub make_warning { |
43
|
6
|
|
|
6
|
0
|
20
|
local $SIG{__WARN__}; |
44
|
|
|
|
|
|
|
|
45
|
6
|
|
|
|
|
8
|
my $msg = shift; |
46
|
6
|
|
|
|
|
23
|
my $warning = Test::NoWarnings::Warning->new; |
47
|
|
|
|
|
|
|
|
48
|
6
|
|
|
|
|
15
|
$warning->setMessage($msg); |
49
|
6
|
|
|
|
|
14
|
$warning->fillTest($TEST); |
50
|
6
|
|
|
|
|
15
|
$warning->fillTrace(__PACKAGE__); |
51
|
|
|
|
|
|
|
|
52
|
6
|
|
|
|
|
9
|
$Carp::Internal{__PACKAGE__.""}++; |
53
|
6
|
|
|
|
|
8
|
local $Carp::CarpLevel = $Carp::CarpLevel + 1; |
54
|
6
|
|
|
|
|
14
|
$warning->fillCarp($msg); |
55
|
6
|
|
|
|
|
20
|
$Carp::Internal{__PACKAGE__.""}--; |
56
|
|
|
|
|
|
|
|
57
|
6
|
|
|
|
|
19
|
return $warning; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# this make a subroutine which can be used in $SIG{__WARN__} |
61
|
|
|
|
|
|
|
# it takes one argument, a ref to an array |
62
|
|
|
|
|
|
|
# it will push the details of the warning onto the end of the array. |
63
|
|
|
|
|
|
|
sub make_catcher { |
64
|
77
|
|
|
77
|
0
|
111
|
my $array = shift; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
return sub { |
67
|
6
|
|
|
6
|
|
329
|
my $msg = shift; |
68
|
|
|
|
|
|
|
|
69
|
6
|
|
|
|
|
46
|
$Carp::Internal{__PACKAGE__.""}++; |
70
|
6
|
|
|
|
|
26
|
push(@$array, make_warning($msg)); |
71
|
6
|
|
|
|
|
9
|
$Carp::Internal{__PACKAGE__.""}--; |
72
|
|
|
|
|
|
|
|
73
|
6
|
|
|
|
|
49
|
return $msg; |
74
|
77
|
|
|
|
|
569
|
}; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub had_no_warnings { |
78
|
79
|
100
|
|
79
|
1
|
3054
|
return 0 if $$ != $PID; |
79
|
|
|
|
|
|
|
|
80
|
77
|
|
|
|
|
426
|
local $SIG{__WARN__}; |
81
|
77
|
|
50
|
|
|
559
|
my $name = shift || "no warnings"; |
82
|
|
|
|
|
|
|
|
83
|
77
|
|
|
|
|
289
|
my $ok; |
84
|
|
|
|
|
|
|
my $diag; |
85
|
77
|
50
|
|
|
|
375
|
if ( @WARNINGS == 0 ) { |
86
|
77
|
|
|
|
|
241
|
$ok = 1; |
87
|
|
|
|
|
|
|
} else { |
88
|
0
|
|
|
|
|
0
|
$ok = 0; |
89
|
0
|
|
|
|
|
0
|
$diag = "There were ".@WARNINGS." warning(s)\n"; |
90
|
0
|
|
|
|
|
0
|
$diag .= join "----------\n", map { $_->toString } @WARNINGS; |
|
0
|
|
|
|
|
0
|
|
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
77
|
50
|
|
|
|
412
|
$TEST->ok($ok, $name) || $TEST->diag($diag); |
94
|
|
|
|
|
|
|
|
95
|
77
|
|
|
|
|
24097
|
return $ok; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub clear_warnings { |
99
|
2
|
|
|
2
|
1
|
657
|
local $SIG{__WARN__}; |
100
|
2
|
|
|
|
|
193
|
@WARNINGS = (); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub warnings { |
104
|
0
|
|
|
0
|
1
|
|
local $SIG{__WARN__}; |
105
|
0
|
|
|
|
|
|
return @WARNINGS; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub builder { |
109
|
0
|
|
|
0
|
0
|
|
local $SIG{__WARN__}; |
110
|
0
|
0
|
|
|
|
|
if ( @_ ) { |
111
|
0
|
|
|
|
|
|
$TEST = shift; |
112
|
|
|
|
|
|
|
} |
113
|
0
|
|
|
|
|
|
return $TEST; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
1; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
__END__ |