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
98
99
100
101
102
103
104
|
#!/usr/bin/perl
BEGIN {
chdir 't' if -d 't';
unshift @INC, '../blib/lib';
}
use strict;
use warnings;
use Carp;
use constant SUBTESTS_PER_TESTS => 6;
use constant TESTS =>(
["ok", "my warning", "my warning", "standard warning to find"],
["not ok", "my warning", "another warning", "another warning instead of my warning"],
["not ok", "warning general not", "warning general", "quite only a sub warning"],
["not ok", undef, "a warning", "no warning, but expected one"],
["not ok", "a warning", undef, "warning, but didn't expect one"],
["ok", undef, undef, "no warning"],
["ok", '$!"%&/()=', '$!"%&/()=', "warning with crazy letters"],
["not ok", "warning 1|warning 2", "warning1", "more than one warning"]
);
use Test::Builder::Tester tests => TESTS() * SUBTESTS_PER_TESTS;
use Test::Warn;
#use Test::Exception;
Test::Builder::Tester::color 'on';
use constant WARN_LINE => line_num +2;
sub _make_warn {
warn $_ for grep $_, split m:\|:, (shift() || "");
}
use constant CARP_LINE => line_num +2;
sub _make_carp {
carp $_ for grep $_, split m:\|:, (shift() || "");
}
use constant CARP_LEVELS => (0 .. 2);
sub _create_exp_warning {
my ($carplevel, $warning) = @_;
return $warning if $carplevel == 0;
return {carped => $warning} if $carplevel == 1;
return {carped => [$warning]} if $carplevel == 2;
}
test_warning_is(@$_) foreach TESTS();
sub test_warning_is {
my ($ok, $msg, $exp_warning, $testname) = @_;
for my $carp (CARP_LEVELS) {
*_found_msg = $carp ? *_found_carp_msg : *_found_warn_msg;
*_exp_msg = $carp ? *_exp_carp_msg : *_exp_warn_msg;
*_make_warn_or_carp = $carp ? *_make_carp : *_make_warn;
for my $t (undef, $testname) {
test_out "$ok 1" . ($t ? " - $t" : "");
if ($ok =~ /not/) {
test_fail +4;
test_diag _found_msg($_) for ($msg ? (split m-\|-, $msg) : $msg);
test_diag _exp_msg($exp_warning);
}
warning_is {_make_warn_or_carp($msg)} _create_exp_warning($carp, $exp_warning), $t;
test_test "$testname (with" . ($_ ? "" : "out") . " a testname)";
}
}
}
sub _found_warn_msg {
defined($_[0])
? ( join " " => ("found warning:",
$_[0],
"at",
__FILE__,
"line",
WARN_LINE . ".") )
: "didn't found a warning";
}
sub _exp_warn_msg {
defined($_[0])
? "expected to find warning: $_[0]"
: "didn't expect to find a warning";
}
sub _found_carp_msg {
defined($_[0])
? ( join " " => ("found carped warning:",
$_[0],
"at",
__FILE__,
"line",
CARP_LINE) ) # Note the difference, that carp msg
: "didn't found a warning"; # aren't finished by '.'
}
sub _exp_carp_msg {
defined($_[0])
? "expected to find carped warning: $_[0]"
: "didn't expect to find a warning";
}
|
