File Coverage

blib/lib/Test/Stream/Event/Ok.pm
Criterion Covered Total %
statement 76 76 100.0
branch 40 40 100.0
condition 16 16 100.0
subroutine 13 13 100.0
pod 4 5 80.0
total 149 150 99.3


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__