File Coverage

inc/TestML/Runtime/TAP.pm
Criterion Covered Total %
statement 32 56 57.1
branch 5 12 41.6
condition 1 6 16.6
subroutine 10 13 76.9
pod 0 10 0.0
total 48 97 49.4


line stmt bran cond sub pod time code
1 1     1   4 use Test::Builder;
  1         1  
  1         28  
2 1     1   4 use TestML::Runtime;
  1         1  
  1         22  
3              
4             package TestML::Runtime::TAP;
5              
6 1     1   4 use TestML::Base;
  1         1  
  1         6  
7             extends 'TestML::Runtime';
8              
9             has tap_object => sub { Test::Builder->new };
10             has planned => 0;
11              
12             sub run {
13 1     1 0 1 my ($self) = @_;
14 1         7 $self->SUPER::run;
15 1         3 $self->check_plan;
16 1         4 $self->plan_end;
17             }
18              
19             sub run_assertion {
20 10     10 0 14 my ($self, @args) = @_;
21 10         18 $self->check_plan;
22 10         27 $self->SUPER::run_assertion(@args);
23             }
24              
25             sub check_plan {
26 11     11 0 7 my ($self) = @_;
27 11 100       22 if (! $self->planned) {
28 1         3 $self->title;
29 1         4 $self->plan_begin;
30 1         2 $self->{planned} = 1;
31             }
32             }
33              
34             sub title {
35 1     1 0 2 my ($self) = @_;
36 1 50       4 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 1     1 0 1 my ($self) = @_;
50 1 50       3 if (my $tests = $self->function->getvar('Plan')) {
51 0         0 $self->tap_object->plan(tests => $tests->value);
52             }
53             }
54              
55             sub plan_end {
56 1     1 0 2 my ($self) = @_;
57 1         4 $self->tap_object->done_testing();
58             }
59              
60             # TODO Use Test::Diff here.
61             sub assert_EQ {
62 10     10 0 11 my ($self, $got, $want) = @_;
63 10         22 $got = $got->str->value;
64 10         20 $want = $want->str->value;
65 10 50 33     22 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 10         20 $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;