|
49
|
1 package IMPL::Test::Unit;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
166
|
5 use parent qw(IMPL::Object);
|
|
49
|
6 use IMPL::Class::Property;
|
|
|
7
|
|
|
8 use Time::HiRes qw(gettimeofday tv_interval);
|
|
|
9
|
|
|
10 use Error qw(:try);
|
|
83
|
11 use Carp qw(carp);
|
|
183
|
12 use File::Spec();
|
|
|
13 use IMPL::Test::Result();
|
|
|
14 use IMPL::Test::FailException();
|
|
|
15 use IMPL::Exception();
|
|
49
|
16
|
|
|
17 BEGIN {
|
|
|
18 public property Name => prop_all;
|
|
|
19 public property Code => prop_all;
|
|
|
20 }
|
|
|
21
|
|
|
22 sub CTOR {
|
|
|
23 my ($this,$info) = @_;
|
|
|
24
|
|
|
25 die new IMPL::InvalidArgumentException("TestInfo should be supplied as an argument") unless $info;
|
|
|
26
|
|
|
27 $this->Name($info->Name || 'Annon');
|
|
|
28 $this->Code($info->Code)or die new IMPL::InvalidOperationException("Can't create test without entry point");
|
|
|
29 }
|
|
|
30
|
|
|
31 sub UnitName {
|
|
|
32 my ($self) = @_;
|
|
|
33 $self->toString;
|
|
|
34 }
|
|
|
35
|
|
|
36 sub Cleanup {
|
|
|
37 my ($this,$session) = @_;
|
|
|
38
|
|
97
|
39 $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1);
|
|
49
|
40
|
|
|
41 1;
|
|
|
42 }
|
|
|
43
|
|
|
44 sub StartUnit {
|
|
|
45 my $class = shift;
|
|
|
46
|
|
|
47 return {};
|
|
|
48 }
|
|
|
49
|
|
|
50 sub InitTest {
|
|
|
51 my ($this,$session) = @_;
|
|
|
52
|
|
97
|
53 $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1);
|
|
49
|
54 }
|
|
|
55
|
|
|
56 sub FinishUnit {
|
|
|
57 my ($class,$session) = @_;
|
|
|
58
|
|
|
59 1;
|
|
|
60 }
|
|
|
61
|
|
|
62 sub List {
|
|
|
63 my $self = shift;
|
|
|
64
|
|
|
65 return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria
|
|
|
66 }
|
|
|
67
|
|
|
68 sub Run {
|
|
|
69 my ($this,$session) = @_;
|
|
|
70
|
|
|
71 my $t = [gettimeofday];
|
|
|
72 return try {
|
|
|
73 $this->InitTest($session);
|
|
|
74 my $code = $this->Code;
|
|
|
75
|
|
|
76
|
|
|
77 my $t0 = [gettimeofday];
|
|
|
78 my $elapsed;
|
|
|
79
|
|
|
80 try {
|
|
|
81 $this->$code();
|
|
|
82 $elapsed = tv_interval ( $t0 );
|
|
|
83 } finally {
|
|
|
84 # we need to call Cleanup anyway
|
|
|
85 $this->Cleanup($session);
|
|
|
86 };
|
|
|
87
|
|
|
88 return new IMPL::Test::Result(
|
|
|
89 Name => $this->Name,
|
|
|
90 State => IMPL::Test::Result::SUCCESS,
|
|
|
91 TimeExclusive => $elapsed,
|
|
|
92 TimeInclusive => tv_interval ( $t )
|
|
|
93 );
|
|
|
94 } catch IMPL::Test::FailException with {
|
|
|
95 my $e = shift;
|
|
|
96 return new IMPL::Test::Result(
|
|
|
97 Name => $this->Name,
|
|
|
98 State => IMPL::Test::Result::FAIL,
|
|
|
99 Exception => $e,
|
|
|
100 TimeInclusive => tv_interval ( $t )
|
|
|
101 );
|
|
|
102 } otherwise {
|
|
|
103 my $e = shift;
|
|
|
104 return new IMPL::Test::Result(
|
|
|
105 Name => $this->Name,
|
|
|
106 State => IMPL::Test::Result::ERROR,
|
|
|
107 Exception => $e,
|
|
|
108 TimeInclusive => tv_interval ( $t )
|
|
|
109 );
|
|
|
110 }
|
|
|
111 }
|
|
|
112
|
|
183
|
113 sub GetResourceFile {
|
|
|
114 my ($this,@path) = @_;
|
|
|
115
|
|
|
116 my ($cwd) = map m/(.*)/, File::Spec->rel2abs(File::Spec->curdir());
|
|
184
|
117 return File::Spec->catfile($cwd,@path);
|
|
183
|
118 }
|
|
|
119
|
|
|
120 sub GetResourceDir {
|
|
|
121 my ($this,@path) = @_;
|
|
|
122
|
|
|
123 my ($cwd) = map m/(.*)/, File::Spec->rel2abs(File::Spec->curdir());
|
|
184
|
124 return File::Spec->catdir($cwd,@path);
|
|
183
|
125 }
|
|
|
126
|
|
49
|
127 package IMPL::Test::Unit::TestInfo;
|
|
166
|
128 use parent qw(IMPL::Object::Meta);
|
|
49
|
129 use IMPL::Class::Property;
|
|
|
130
|
|
|
131 require IMPL::Exception;
|
|
|
132
|
|
|
133 BEGIN {
|
|
|
134 public property Name => prop_all;
|
|
|
135 public property Code => prop_all;
|
|
|
136 }
|
|
|
137
|
|
|
138 sub CTOR {
|
|
|
139 my ($this,$name,$code) = @_;
|
|
|
140
|
|
|
141 $this->Name($name);
|
|
|
142 $this->Code($code) or die new IMPL::InvalidArgumentException("The Code is a required parameter");
|
|
|
143 }
|
|
|
144
|
|
|
145 package IMPL::Test::Unit::SharedData;
|
|
166
|
146 use parent qw(IMPL::Object::Meta);
|
|
49
|
147 use IMPL::Class::Property;
|
|
|
148
|
|
|
149 BEGIN {
|
|
|
150 public property DataList => prop_all | prop_list;
|
|
|
151 }
|
|
|
152
|
|
|
153 sub CTOR {
|
|
|
154 my $this = shift;
|
|
|
155
|
|
|
156 $this->DataList(\@_);
|
|
|
157 }
|
|
|
158 1;
|
