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