|
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 {
|
|
14
|
39 my ($this,$session) = @_;
|
|
|
40
|
|
|
41 $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData');
|
|
|
42
|
|
0
|
43 1;
|
|
|
44 }
|
|
|
45
|
|
|
46 sub StartUnit {
|
|
|
47 my $class = shift;
|
|
|
48
|
|
|
49 return {};
|
|
|
50 }
|
|
|
51
|
|
|
52 sub InitTest {
|
|
|
53 my ($this,$session) = @_;
|
|
|
54
|
|
|
55 $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData');
|
|
|
56 }
|
|
|
57
|
|
|
58 sub FinishUnit {
|
|
|
59 my ($class,$session) = @_;
|
|
|
60
|
|
|
61 1;
|
|
|
62 }
|
|
|
63
|
|
|
64 sub List {
|
|
|
65 my $self = shift;
|
|
|
66
|
|
|
67 return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria
|
|
|
68 }
|
|
|
69
|
|
|
70 sub Run {
|
|
|
71 my ($this,$session) = @_;
|
|
|
72
|
|
|
73 my $t = [gettimeofday];
|
|
|
74 return try {
|
|
|
75 $this->InitTest($session);
|
|
|
76 $this->Setup;
|
|
|
77 my $code = $this->Code;
|
|
|
78
|
|
|
79
|
|
|
80 my $t0 = [gettimeofday];
|
|
|
81 my $elapsed;
|
|
|
82
|
|
|
83 try {
|
|
|
84 $this->$code();
|
|
|
85 $elapsed = tv_interval ( $t0 );
|
|
|
86 } finally {
|
|
|
87 # we need to call Cleanup anyway
|
|
14
|
88 $this->Cleanup($session);
|
|
0
|
89 };
|
|
|
90
|
|
|
91 return new IMPL::Test::Result(
|
|
|
92 Name => $this->Name,
|
|
|
93 State => IMPL::Test::Result::SUCCESS,
|
|
|
94 TimeExclusive => $elapsed,
|
|
|
95 TimeInclusive => tv_interval ( $t )
|
|
|
96 );
|
|
|
97 } catch IMPL::Test::FailException with {
|
|
|
98 my $e = shift;
|
|
|
99 return new IMPL::Test::Result(
|
|
|
100 Name => $this->Name,
|
|
|
101 State => IMPL::Test::Result::FAIL,
|
|
|
102 Exception => $e,
|
|
|
103 TimeInclusive => tv_interval ( $t )
|
|
|
104 );
|
|
|
105 } otherwise {
|
|
|
106 my $e = shift;
|
|
|
107 return new IMPL::Test::Result(
|
|
|
108 Name => $this->Name,
|
|
|
109 State => IMPL::Test::Result::ERROR,
|
|
|
110 Exception => $e,
|
|
|
111 TimeInclusive => tv_interval ( $t )
|
|
|
112 );
|
|
|
113 }
|
|
|
114 }
|
|
|
115
|
|
|
116 package IMPL::Test::Unit::TestInfo;
|
|
|
117 use base qw(IMPL::Object::Meta);
|
|
|
118 use IMPL::Class::Property;
|
|
|
119
|
|
|
120 require IMPL::Exception;
|
|
|
121
|
|
|
122 BEGIN {
|
|
|
123 public property Name => prop_all;
|
|
|
124 public property Code => prop_all;
|
|
|
125 }
|
|
|
126
|
|
|
127 sub CTOR {
|
|
|
128 my ($this,$name,$code) = @_;
|
|
|
129
|
|
|
130 $this->Name($name);
|
|
|
131 $this->Code($code) or die new IMPL::InvalidArgumentException("The Code is a required parameter");
|
|
|
132 }
|
|
|
133
|
|
|
134 package IMPL::Test::Unit::SharedData;
|
|
|
135 use base qw(IMPL::Object::Meta);
|
|
|
136 use IMPL::Class::Property;
|
|
|
137
|
|
|
138 BEGIN {
|
|
|
139 public property DataList => prop_all | prop_list;
|
|
|
140 }
|
|
|
141
|
|
|
142 sub CTOR {
|
|
|
143 my $this = shift;
|
|
|
144
|
|
|
145 $this->DataList(\@_);
|
|
|
146 }
|
|
|
147 1;
|
