File Coverage

blib/lib/Test/TAP/Model/File.pm

Criterion	Covered	Total	%
statement	88	89	98.8
branch	23	28	82.1
condition	3	3	100.0
subroutine	34	35	97.1
pod	18	19	94.7
total	166	174	95.4

#!/usr/bin/perl

package Test::TAP::Model::File;

use strict;
use warnings;

use Test::TAP::Model::Subtest;
use List::Util (); # don't import max, we have our own. We use it fully qualified

use overload '""' => "name", '==' => "equal";

use Method::Alias (
	(map { ($_ => 'cases') } qw/seen_tests seen test_cases subtests/),
	(map { ($_ => 'ok_tests') } qw/passed_tests/),
	(map { ($_ => 'nok_tests') } qw/failed_tests/),
	(map { ($_ => 'planned') } qw/max/),
	(map { ($_ => 'ok') } qw/passed/),
	(map { ($_ => 'nok') } qw/failed/),
);

# TODO test this more thoroughly, probably with Devel::Cover

sub new {
	my $pkg = shift;
	my $struct = shift;
	bless { struct => $struct }, $pkg; # don't bless the structure, it's not ours to mess with
}

# predicates about the test file
sub ok { $_[0]{struct}{results}->passing };
sub nok { !$_[0]->ok };
sub skipped { defined($_[0]{struct}{results}->skip_all) };
sub bailed_out {
	my $event = $_[0]{struct}{events}[-1] or return;
	return unless exists $event->{type};
	return $event->{type} eq "bailout";
}

# member data queries
sub name { $_[0]{struct}{file} }

# utility methods for extracting tests.
sub subtest_class { "Test::TAP::Model::Subtest" }
sub _mk_objs { my $self = shift; wantarray ? map { $self->subtest_class->new($_) } @_ : @_ }
sub _test_structs {
	my $self = shift;
	my $max = $self->{struct}{results}->max;

	# cases is an array of *copies*... that's what the map is about
	my @cases = grep { exists $_->{type} and $_->{type} eq "test" } @{ $self->{struct}{events} };

	if (defined $max){
		if ($max > @cases){
			# add failed stubs for tests missing from plan
			my %bailed = (
				type => "test",
				ok => 0,
				line => "stub",
			);

			for my $num (@cases + 1 .. $max) {
				push @cases, { %bailed, num => $num };
			}
		} elsif (@cases > $max) {
			# mark extra tests as unplanned
			my $diff = @cases - $max;
			for (my $i = $diff; $i; $i--){
				$cases[-$i]{unplanned} = 1;
			}
		}
	}

	@cases;
}
sub _c {
	my $self = shift;
	my $sub = shift;
	my $scalar = shift;
	return $scalar if not wantarray and defined $scalar; # if we have a precomputed scalar
	$self->_mk_objs(grep { &$sub } $self->_test_structs);
}

# queries about the test cases
sub planned { $_[0]{struct}{results}->max };

sub cases {
	my @values = map { $_[0]{struct}{results}->$_ } qw/seen max/;
	my $scalar = List::Util::max(@values);
	$_[0]->_c(sub { 1 }, $scalar)
};
sub actual_cases { $_[0]->_c(sub { $_->{line} ne "stub" }, $_[0]{struct}{results}->seen) }
sub ok_tests { $_[0]->_c(sub { $_->{ok} }, $_[0]{struct}{results}->ok) };
sub nok_tests { $_[0]->_c(sub { not $_->{ok} }, $_[0]->seen - $_[0]->ok_tests )};
sub todo_tests { $_[0]->_c(sub { $_->{todo} }, $_[0]{struct}{results}->todo) }
sub skipped_tests { $_[0]->_c(sub { $_->{skip} }, $_[0]{struct}{results}->skip) }
sub unexpectedly_succeeded_tests { $_[0]->_c(sub { $_->{todo} and $_->{actual_ok} }) }

sub ratio {
	my $self = shift;
	$self->seen ? $self->ok_tests / $self->seen : ($self->ok ? 1 : 0); # no tests is an error
}

sub percentage {
	my $self = shift;
	sprintf("%.2f%%", 100 * $self->ratio);
}

sub pre_diag { $_[0]{struct}{pre_diag} || ""}

sub equal {
	my $self = shift;
	my $other = shift;

	# number of sub-tests
	return unless $self->seen == $other->seen;

	# values of subtests
	my @self = $self->cases;
	my @other = $other->cases;

	while (@self) {
		return unless (pop @self) == (pop @other);
	}

	1;
}

__PACKAGE__

__END__