|
407
|
1 package IMPL::Test::TAPListener;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use parent qw(IMPL::Object IMPL::Object::Serializable);
|
|
|
6 use IMPL::Class::Property;
|
|
|
7 use IMPL::Test::Result;
|
|
|
8
|
|
|
9 BEGIN {
|
|
|
10 private property _Output => prop_all;
|
|
|
11 private property _testNo => prop_all;
|
|
|
12 }
|
|
|
13
|
|
|
14 sub CTOR {
|
|
|
15 my ($this,$out) = @_;
|
|
|
16
|
|
|
17 $this->_Output($out || *STDOUT);
|
|
|
18 $this->_testNo(1);
|
|
|
19 }
|
|
|
20
|
|
|
21 sub RunPlan {
|
|
|
22 my ($this,$plan) = @_;
|
|
|
23
|
|
|
24 my $out = $this->_Output;
|
|
|
25
|
|
|
26 print $out "1..",$plan->Count,"\n";
|
|
|
27 }
|
|
|
28
|
|
|
29 sub EndPlan {
|
|
|
30
|
|
|
31 }
|
|
|
32
|
|
|
33 sub RunUnit {
|
|
|
34 my ($this,$unit) = @_;
|
|
|
35
|
|
|
36 my $out = $this->_Output;
|
|
|
37
|
|
|
38 print $out "#\n",join("\n",map "# $_", split /\n/, "Running unit: " . $unit->UnitName, ),"\n#\n";
|
|
|
39 }
|
|
|
40
|
|
|
41 sub EndUnit {
|
|
|
42
|
|
|
43 }
|
|
|
44
|
|
|
45 sub RunTest {
|
|
|
46
|
|
|
47 }
|
|
|
48
|
|
|
49 sub EndTest {
|
|
|
50 my ($this,$test,$result) = @_;
|
|
|
51
|
|
|
52 my $out = $this->_Output;
|
|
|
53 my $n = $this->_testNo;
|
|
|
54
|
|
|
55 $this->_testNo($n+1);
|
|
|
56
|
|
|
57 print $out (
|
|
|
58 $result->State == IMPL::Test::Result::SUCCESS ?
|
|
|
59 "ok $n " . join("\n# ", split(/\n/, $result->Name) )
|
|
|
60 :
|
|
|
61 (eval { $result->Exception->isa('IMPL::Test::SkipException') } ? "ok $n #SKIP: " : "not ok $n ") . join("\n# ", split(/\n/, $result->Name.": ".$result->Exception || '') )
|
|
|
62 ),"\n";
|
|
|
63
|
|
|
64 }
|
|
|
65
|
|
|
66 sub save {
|
|
|
67
|
|
|
68 }
|
|
|
69
|
|
|
70 1;
|
