File Coverage

blib/lib/Test/Stream/Event/Ok.pm

Criterion	Covered	Total	%
statement	73	73	100.0
branch	40	40	100.0
condition	16	16	100.0
subroutine	12	12	100.0
pod	4	5	80.0
total	145	146	99.3

package Test::Stream::Event::Ok;
use strict;
use warnings;

use Scalar::Util qw/blessed/;
use Carp qw/confess/;

use Test::Stream::Formatter::TAP qw/OUT_STD OUT_TODO OUT_ERR/;

use Test::Stream::Event::Diag;

use Test::Stream::Event(
    accessors => [qw/pass effective_pass name diag allow_bad_name/],
);

sub init {
    my $self = shift;

    confess("No debug info provided!") unless $self->{+DEBUG};

    # Do not store objects here, only true or false
    $self->{+PASS} = $self->{+PASS} ? 1 : 0;

    $self->{+EFFECTIVE_PASS} = $self->{+PASS} || $self->{+DEBUG}->no_fail || 0;

    return if $self->{+ALLOW_BAD_NAME};
    my $name = $self->{+NAME} || return;
    return unless index($name, '#') != -1 || index($name, "\n") != -1;
    $self->debug->throw("'$name' is not a valid name, names must not contain '#' or newlines.")
}

sub to_tap {
    my $self = shift;
    my ($num) = @_;

    my $name  = $self->{+NAME};
    my $debug = $self->{+DEBUG};
    my $skip  = $debug->{skip};
    my $todo  = $debug->{todo};

    my $out = "";
    $out .= "not " unless $self->{+PASS};
    $out .= "ok";
    $out .= " $num" if defined $num;
    $out .= " - $name" if $name;

    if (defined $skip && defined $todo) {
        $out .= " # TODO & SKIP";
        $out .= " $todo" if length $todo;
    }
    elsif (defined $todo) {
        $out .= " # TODO";
        $out .= " $todo" if length $todo;
    }
    elsif (defined $skip) {
        $out .= " # skip";
        $out .= " $skip" if length $skip;
    }

    my @out = [OUT_STD, "$out\n"];

    if ($self->{+DIAG} && @{$self->{+DIAG}}) {
        my $diag_handle = $debug->no_diag ? OUT_TODO : OUT_ERR;

        for my $diag (@{$self->{+DIAG}}) {
            chomp(my $msg = $diag);

            $msg = "# $msg" unless $msg =~ m/^\n/;
            $msg =~ s/\n/\n# /g;
            push @out => [$diag_handle, "$msg\n"];
        }
    }

    return @out;
}

sub default_diag {
    my $self = shift;

    return if $self->{+PASS};

    my $name  = $self->{+NAME};
    my $dbg   = $self->{+DEBUG};
    my $pass  = $self->{+PASS};
    my $todo  = defined $dbg->todo;

    my $msg = $todo ? "Failed (TODO)" : "Failed";
    my $prefix = $ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_IS_VERBOSE} ? "\n" : "";

    my $trace = $dbg->trace;

    if (defined $name) {
        $msg = qq[$prefix$msg test '$name'\n$trace.];
    }
    else {
        $msg = qq[$prefix$msg test $trace.];
    }

    return $msg;
}

sub update_state { $_[1]->bump($_[0]->{+EFFECTIVE_PASS}) }

sub causes_fail { !$_[0]->{+EFFECTIVE_PASS} }

1;

__END__