#!/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__ =pod =head1 NAME Test::TAP::Model::File - an object representing the TAP results of a single test script's output. =head1 SYNOPSIS my $f = ( $t->test_files )[0]; if ($f->ok){ # et cetera print "happy happy joy joy!"; } =head1 DESCRIPTION This is a convenience object, which is more of a library of questions you can ask about the hash structure described in L. It's purpose is to help you query status concisely, probably from a templating kit. =head1 METHODS =head2 Miscelleneous =over 4 =item new This constructor accepts a hash like you can find in the return value of L. It does not bless that structure to stay friendly with others. Instead it blesses a scalar reference to it. =item subtest_class This returns the name of the class used to construct subtest objects using methods like L. =back =head2 Predicates About the File =over 4 =item ok =item passed Whether the file as a whole passed =item nok =item failed Or failed =item skipped Whether skip_all was done at some point =item bailed_out Whether test bailed out =back =head2 Misc info =over 4 =item name The name of the test file. =item =back =head2 Methods for Extracting Subtests =over 4 =item cases =item subtests =item test_cases =item seen_tests =item seen In scalar context, a number, in list context, a list of L objects This value is somewhat massaged, with stubs created for planned tests which were never reached. =item actual_cases This method returns the same thing as C and friends, but without the stubs. =item max =item planned Just a number, of the expected test count. =item ok_tests =item passed_tests Subtests which passed =item nok_tests =item failed_tests Duh. Same list/scalar context sensitivity applies. =item todo_tests Subtests marked TODO. =item skipped_tests Test which are vegeterian. =item unexpectedly_succeeded_tests Please tell me you're not really reading these decriptions. The're really only to get the =items sepeared in whatever POD viewer you are using. =back =head2 Statistical goodness =over 4 =item ratio OK/(max seen, planned) =item percentage Pretty printed ratio in percentage, with two decimal points and a percent sign. =item pre_diag Any diagnosis output seen in TAP that came before a subtest. =cut