1#!/usr/bin/perl
2
3package Test::TAP::Model::File;
4
5use strict;
6use warnings;
7
8use Test::TAP::Model::Subtest;
9use List::Util (); # don't import max, we have our own. We use it fully qualified
10
11use overload '""' => "name", '==' => "equal";
12
13use Method::Alias (
14	(map { ($_ => 'cases') } qw/seen_tests seen test_cases subtests/),
15	(map { ($_ => 'ok_tests') } qw/passed_tests/),
16	(map { ($_ => 'nok_tests') } qw/failed_tests/),
17	(map { ($_ => 'planned') } qw/max/),
18	(map { ($_ => 'ok') } qw/passed/),
19	(map { ($_ => 'nok') } qw/failed/),
20);
21
22# TODO test this more thoroughly, probably with Devel::Cover
23
24sub new {
25	my $pkg = shift;
26	my $struct = shift;
27	bless { struct => $struct }, $pkg; # don't bless the structure, it's not ours to mess with
28}
29
30# predicates about the test file
31sub ok { $_[0]{struct}{results}->passing };
32sub nok { !$_[0]->ok };
33sub skipped { defined($_[0]{struct}{results}->skip_all) };
34sub bailed_out {
35	my $event = $_[0]{struct}{events}[-1] or return;
36	return unless exists $event->{type};
37	return $event->{type} eq "bailout";
38}
39
40# member data queries
41sub name { $_[0]{struct}{file} }
42
43# utility methods for extracting tests.
44sub subtest_class { "Test::TAP::Model::Subtest" }
45sub _mk_objs { my $self = shift; wantarray ? map { $self->subtest_class->new($_) } @_ : @_ }
46sub _test_structs {
47	my $self = shift;
48	my $max = $self->{struct}{results}->max;
49
50	# cases is an array of *copies*... that's what the map is about
51	my @cases = grep { exists $_->{type} and $_->{type} eq "test" } @{ $self->{struct}{events} };
52
53	if (defined $max){
54		if ($max > @cases){
55			# add failed stubs for tests missing from plan
56			my %bailed = (
57				type => "test",
58				ok => 0,
59				line => "stub",
60			);
61
62			for my $num (@cases + 1 .. $max) {
63				push @cases, { %bailed, num => $num };
64			}
65		} elsif (@cases > $max) {
66			# mark extra tests as unplanned
67			my $diff = @cases - $max;
68			for (my $i = $diff; $i; $i--){
69				$cases[-$i]{unplanned} = 1;
70			}
71		}
72	}
73
74	@cases;
75}
76sub _c {
77	my $self = shift;
78	my $sub = shift;
79	my $scalar = shift;
80	return $scalar if not wantarray and defined $scalar; # if we have a precomputed scalar
81	$self->_mk_objs(grep { &$sub } $self->_test_structs);
82}
83
84# queries about the test cases
85sub planned { $_[0]{struct}{results}->max };
86
87sub cases {
88	my @values = map { $_[0]{struct}{results}->$_ } qw/seen max/;
89	my $scalar = List::Util::max(@values);
90	$_[0]->_c(sub { 1 }, $scalar)
91};
92sub actual_cases { $_[0]->_c(sub { $_->{line} ne "stub" }, $_[0]{struct}{results}->seen) }
93sub ok_tests { $_[0]->_c(sub { $_->{ok} }, $_[0]{struct}{results}->ok) };
94sub nok_tests { $_[0]->_c(sub { not $_->{ok} }, $_[0]->seen - $_[0]->ok_tests )};
95sub todo_tests { $_[0]->_c(sub { $_->{todo} }, $_[0]{struct}{results}->todo) }
96sub skipped_tests { $_[0]->_c(sub { $_->{skip} }, $_[0]{struct}{results}->skip) }
97sub unexpectedly_succeeded_tests { $_[0]->_c(sub { $_->{todo} and $_->{actual_ok} }) }
98
99sub ratio {
100	my $self = shift;
101	$self->seen ? $self->ok_tests / $self->seen : ($self->ok ? 1 : 0); # no tests is an error
102}
103
104sub percentage {
105	my $self = shift;
106	sprintf("%.2f%%", 100 * $self->ratio);
107}
108
109sub pre_diag { $_[0]{struct}{pre_diag} || ""}
110
111sub equal {
112	my $self = shift;
113	my $other = shift;
114
115	# number of sub-tests
116	return unless $self->seen == $other->seen;
117
118	# values of subtests
119	my @self = $self->cases;
120	my @other = $other->cases;
121
122	while (@self) {
123		return unless (pop @self) == (pop @other);
124	}
125
126	1;
127}
128
129__PACKAGE__
130
131__END__
132
133=pod
134
135=head1 NAME
136
137Test::TAP::Model::File - an object representing the TAP results of a single
138test script's output.
139
140=head1 SYNOPSIS
141
142	my $f = ( $t->test_files )[0];
143
144	if ($f->ok){ # et cetera
145		print "happy happy joy joy!";
146	}
147
148=head1 DESCRIPTION
149
150This is a convenience object, which is more of a library of questions you can
151ask about the hash structure described in L<Test::TAP::Model>.
152
153It's purpose is to help you query status concisely, probably from a templating
154kit.
155
156=head1 METHODS
157
158=head2 Miscelleneous
159
160=over 4
161
162=item new
163
164This constructor accepts a hash like you can find in the return value of
165L<Test::TAP::Model/structure>.
166
167It does not bless that structure to stay friendly with others. Instead it
168blesses a scalar reference to it.
169
170=item subtest_class
171
172This returns the name of the class used to construct subtest objects using
173methods like L<ok_tests>.
174
175=back
176
177=head2 Predicates About the File
178
179=over 4
180
181=item ok
182
183=item passed
184
185Whether the file as a whole passed
186
187=item nok
188
189=item failed
190
191Or failed
192
193=item skipped
194
195Whether skip_all was done at some point
196
197=item bailed_out
198
199Whether test bailed out
200
201=back
202
203=head2 Misc info
204
205=over 4
206
207=item name
208
209The name of the test file.
210
211=item
212
213=back
214
215=head2 Methods for Extracting Subtests
216
217=over 4
218
219=item cases
220
221=item subtests
222
223=item test_cases
224
225=item seen_tests
226
227=item seen
228
229In scalar context, a number, in list context, a list of
230L<Test::TAP::Model::Subtest> objects
231
232This value is somewhat massaged, with stubs created for planned tests which
233were never reached.
234
235=item actual_cases
236
237This method returns the same thing as C<cases> and friends, but without the
238stubs.
239
240=item max
241
242=item planned
243
244Just a number, of the expected test count.
245
246=item ok_tests
247
248=item passed_tests
249
250Subtests which passed
251
252=item nok_tests
253
254=item failed_tests
255
256Duh. Same list/scalar context sensitivity applies.
257
258=item todo_tests
259
260Subtests marked TODO.
261
262=item skipped_tests
263
264Test which are vegeterian.
265
266=item unexpectedly_succeeded_tests
267
268Please tell me you're not really reading these decriptions. The're really only
269to get the =items sepeared in whatever POD viewer you are using.
270
271=back
272
273=head2 Statistical goodness
274
275=over 4
276
277=item ratio
278
279OK/(max seen, planned)
280
281=item percentage
282
283Pretty printed ratio in percentage, with two decimal points and a percent sign.
284
285=item pre_diag
286
287Any diagnosis output seen in TAP that came before a subtest.
288
289=cut
290