File Coverage

inc/TestML/Runtime/TAP.pm
Criterion Covered Total %
statement 33 56 58.9
branch 5 12 41.6
condition 1 6 16.6
subroutine 10 13 76.9
pod 0 10 0.0
total 49 97 50.5


line stmt bran cond sub pod time code
1 4     4   1580 use Test::Builder;
  4         24467  
  4         179  
2 4     4   29 use TestML::Runtime;
  4         6  
  4         152  
3              
4             package TestML::Runtime::TAP;
5              
6 4     4   24 use TestML::Base;
  4         8  
  4         28  
7             extends 'TestML::Runtime';
8              
9             has tap_object => sub { Test::Builder->new };
10             has planned => 0;
11              
12             sub run {
13 4     4 0 11 my ($self) = @_;
14 4         35 $self->SUPER::run;
15 4         20 $self->check_plan;
16 4         26 $self->plan_end;
17             }
18              
19             sub run_assertion {
20 6     6 0 26 my ($self, @args) = @_;
21 6         34 $self->check_plan;
22 6         93 $self->SUPER::run_assertion(@args);
23             }
24              
25             sub check_plan {
26 10     10 0 23 my ($self) = @_;
27 10 100       51 if (! $self->planned) {
28 4         22 $self->title;
29 4         25 $self->plan_begin;
30 4         1416 $self->{planned} = 1;
31             }
32             }
33              
34             sub title {
35 4     4 0 13 my ($self) = @_;
36 4 50       31 if (my $title = $self->function->getvar('Title')) {
37 0         0 $title = $title->value;
38 0         0 $title = "=== $title ===\n";
39 0         0 $self->tap_object->note($title);
40             }
41             }
42              
43             sub skip_test {
44 0     0 0 0 my ($self, $reason) = @_;
45 0         0 $self->tap_object->plan(skip_all => $reason);
46             }
47              
48             sub plan_begin {
49 4     4 0 9 my ($self) = @_;
50 4 50       21 if (my $tests = $self->function->getvar('Plan')) {
51 4         15 $self->tap_object->plan(tests => $tests->value);
52             }
53             }
54              
55             sub plan_end {
56 4     4 0 10 my ($self) = @_;
57 4         18 $self->tap_object->done_testing();
58             }
59              
60             # TODO Use Test::Diff here.
61             sub assert_EQ {
62 6     6 0 16 my ($self, $got, $want) = @_;
63 6         102 $got = $got->str->value;
64 6         31 $want = $want->str->value;
65 6 50 33     61 if ($got ne $want and $want =~ /\n/) {
66 0         0 my $block = $self->function->getvar('Block');
67 0         0 my $diff = $self->function->getvar('Diff');
68 0 0 0     0 if ($diff or exists $block->points->{DIFF}) {
69 0         0 require Text::Diff;
70 0         0 $self->tap_object->ok(0, $self->get_label);
71 0         0 my $diff = Text::Diff::diff(
72             \$want, \$got, {
73             FILENAME_A => "want",
74             FILENAME_B => "got",
75             },
76             );
77 0         0 $self->tap_object->diag($diff);
78 0         0 return;
79             }
80             }
81             $self->tap_object->is_eq(
82 6         56 $got,
83             $want,
84             $self->get_label,
85             );
86             }
87              
88             sub assert_HAS {
89 0     0 0   my ($self, $got, $has) = @_;
90 0           $got = $got->str->value;
91 0           $has = $has->str->value;
92 0           my $assertion = (index($got, $has) >= 0);
93 0 0         if (not $assertion) {
94 0           my $msg = <<"...";
95             Failed TestML HAS (~~) assertion. This text:
96             '$got'
97             does not contain this string:
98             '$has'
99             ...
100 0           $self->tap_object->diag($msg);
101             }
102 0           $self->tap_object->ok($assertion, $self->get_label);
103             }
104              
105             sub assert_OK {
106 0     0 0   my ($self, $got) = @_;
107 0           $self->tap_object->ok(
108             $got->bool->value,
109             $self->get_label,
110             );
111             }
112              
113             1;