line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Stream::Event::Ok; |
2
|
107
|
|
|
107
|
|
706
|
use strict; |
|
107
|
|
|
|
|
110
|
|
|
107
|
|
|
|
|
2577
|
|
3
|
107
|
|
|
107
|
|
325
|
use warnings; |
|
107
|
|
|
|
|
103
|
|
|
107
|
|
|
|
|
2327
|
|
4
|
|
|
|
|
|
|
|
5
|
107
|
|
|
107
|
|
321
|
use Scalar::Util qw/blessed/; |
|
107
|
|
|
|
|
110
|
|
|
107
|
|
|
|
|
4196
|
|
6
|
107
|
|
|
107
|
|
359
|
use Carp qw/confess/; |
|
107
|
|
|
|
|
92
|
|
|
107
|
|
|
|
|
3840
|
|
7
|
|
|
|
|
|
|
|
8
|
107
|
|
|
107
|
|
35150
|
use Test::Stream::Formatter::TAP qw/OUT_STD OUT_TODO OUT_ERR/; |
|
107
|
|
|
|
|
149
|
|
|
107
|
|
|
|
|
283
|
|
9
|
|
|
|
|
|
|
|
10
|
107
|
|
|
107
|
|
35654
|
use Test::Stream::Event::Diag(); |
|
107
|
|
|
|
|
177
|
|
|
107
|
|
|
|
|
1758
|
|
11
|
|
|
|
|
|
|
|
12
|
107
|
|
|
107
|
|
397
|
use base 'Test::Stream::Event'; |
|
107
|
|
|
|
|
120
|
|
|
107
|
|
|
|
|
6623
|
|
13
|
107
|
|
|
107
|
|
387
|
use Test::Stream::HashBase accessors => [qw/pass effective_pass name diag allow_bad_name/]; |
|
107
|
|
|
|
|
108
|
|
|
107
|
|
|
|
|
398
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub init { |
16
|
3253
|
|
|
3253
|
0
|
3876
|
my $self = shift; |
17
|
|
|
|
|
|
|
|
18
|
3253
|
100
|
|
|
|
6218
|
confess("No debug info provided!") unless $self->{+DEBUG}; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Do not store objects here, only true or false |
21
|
3252
|
100
|
|
|
|
5166
|
$self->{+PASS} = $self->{+PASS} ? 1 : 0; |
22
|
|
|
|
|
|
|
|
23
|
3252
|
|
100
|
|
|
7501
|
$self->{+EFFECTIVE_PASS} = $self->{+PASS} || $self->{+DEBUG}->no_fail || 0; |
24
|
|
|
|
|
|
|
|
25
|
3252
|
100
|
|
|
|
4899
|
return if $self->{+ALLOW_BAD_NAME}; |
26
|
3251
|
|
100
|
|
|
5140
|
my $name = $self->{+NAME} || return; |
27
|
3174
|
100
|
100
|
|
|
15469
|
return unless index($name, '#') != -1 || index($name, "\n") != -1; |
28
|
2
|
|
|
|
|
10
|
$self->debug->throw("'$name' is not a valid name, names must not contain '#' or newlines.") |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub to_tap { |
32
|
2954
|
|
|
2954
|
1
|
2291
|
my $self = shift; |
33
|
2954
|
|
|
|
|
2274
|
my ($num) = @_; |
34
|
|
|
|
|
|
|
|
35
|
2954
|
|
|
|
|
2725
|
my $name = $self->{+NAME}; |
36
|
2954
|
|
|
|
|
2278
|
my $debug = $self->{+DEBUG}; |
37
|
2954
|
|
|
|
|
2340
|
my $skip = $debug->{skip}; |
38
|
2954
|
|
|
|
|
2144
|
my $todo = $debug->{todo}; |
39
|
|
|
|
|
|
|
|
40
|
2954
|
|
|
|
|
2432
|
my $out = ""; |
41
|
2954
|
100
|
|
|
|
4010
|
$out .= "not " unless $self->{+PASS}; |
42
|
2954
|
|
|
|
|
2579
|
$out .= "ok"; |
43
|
2954
|
100
|
|
|
|
4730
|
$out .= " $num" if defined $num; |
44
|
2954
|
100
|
|
|
|
4834
|
$out .= " - $name" if $name; |
45
|
|
|
|
|
|
|
|
46
|
2954
|
100
|
100
|
|
|
8214
|
if (defined $skip && defined $todo) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
47
|
4
|
|
|
|
|
6
|
$out .= " # TODO & SKIP"; |
48
|
4
|
100
|
|
|
|
21
|
$out .= " $todo" if length $todo; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
elsif (defined $todo) { |
51
|
10
|
|
|
|
|
13
|
$out .= " # TODO"; |
52
|
10
|
100
|
|
|
|
30
|
$out .= " $todo" if length $todo; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
elsif (defined $skip) { |
55
|
7
|
|
|
|
|
10
|
$out .= " # skip"; |
56
|
7
|
100
|
|
|
|
19
|
$out .= " $skip" if length $skip; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
2954
|
|
|
|
|
5846
|
my @out = [OUT_STD, "$out\n"]; |
60
|
|
|
|
|
|
|
|
61
|
2954
|
100
|
100
|
|
|
5734
|
if ($self->{+DIAG} && @{$self->{+DIAG}}) { |
|
21
|
|
|
|
|
60
|
|
62
|
19
|
100
|
|
|
|
47
|
my $diag_handle = $debug->no_diag ? OUT_TODO : OUT_ERR; |
63
|
|
|
|
|
|
|
|
64
|
19
|
|
|
|
|
21
|
for my $diag (@{$self->{+DIAG}}) { |
|
19
|
|
|
|
|
33
|
|
65
|
28
|
|
|
|
|
45
|
chomp(my $msg = $diag); |
66
|
|
|
|
|
|
|
|
67
|
28
|
100
|
|
|
|
116
|
$msg = "# $msg" unless $msg =~ m/^\n/; |
68
|
28
|
|
|
|
|
58
|
$msg =~ s/\n/\n# /g; |
69
|
28
|
|
|
|
|
67
|
push @out => [$diag_handle, "$msg\n"]; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
2954
|
|
|
|
|
5610
|
return @out; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub default_diag { |
77
|
207
|
|
|
207
|
1
|
224
|
my $self = shift; |
78
|
|
|
|
|
|
|
|
79
|
207
|
100
|
|
|
|
429
|
return if $self->{+PASS}; |
80
|
|
|
|
|
|
|
|
81
|
206
|
|
|
|
|
224
|
my $name = $self->{+NAME}; |
82
|
206
|
|
|
|
|
195
|
my $dbg = $self->{+DEBUG}; |
83
|
206
|
|
|
|
|
246
|
my $pass = $self->{+PASS}; |
84
|
206
|
|
|
|
|
567
|
my $todo = defined $dbg->todo; |
85
|
|
|
|
|
|
|
|
86
|
206
|
100
|
|
|
|
678
|
my $msg = $todo ? "Failed (TODO)" : "Failed"; |
87
|
206
|
100
|
100
|
|
|
844
|
my $prefix = $ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_IS_VERBOSE} ? "\n" : ""; |
88
|
|
|
|
|
|
|
|
89
|
206
|
|
|
|
|
466
|
my $trace = $dbg->trace; |
90
|
|
|
|
|
|
|
|
91
|
206
|
100
|
|
|
|
326
|
if (defined $name) { |
92
|
165
|
|
|
|
|
407
|
$msg = qq[$prefix$msg test '$name'\n$trace.]; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
else { |
95
|
41
|
|
|
|
|
85
|
$msg = qq[$prefix$msg test $trace.]; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
206
|
|
|
|
|
614
|
return $msg; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
3218
|
|
|
3218
|
1
|
7680
|
sub update_state { $_[1]->bump($_[0]->{+EFFECTIVE_PASS}) } |
102
|
|
|
|
|
|
|
|
103
|
1775
|
|
|
1775
|
1
|
6616
|
sub causes_fail { !$_[0]->{+EFFECTIVE_PASS} } |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
1; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
__END__ |