|
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);
|
|
49
|
12 use IMPL::Test::Result;
|
|
|
13 use IMPL::Test::FailException;
|
|
|
14 use IMPL::Exception;
|
|
|
15
|
|
|
16 BEGIN {
|
|
|
17 public property Name => prop_all;
|
|
|
18 public property Code => prop_all;
|
|
|
19 }
|
|
|
20
|
|
|
21 sub CTOR {
|
|
|
22 my ($this,$info) = @_;
|
|
|
23
|
|
|
24 die new IMPL::InvalidArgumentException("TestInfo should be supplied as an argument") unless $info;
|
|
|
25
|
|
|
26 $this->Name($info->Name || 'Annon');
|
|
|
27 $this->Code($info->Code)or die new IMPL::InvalidOperationException("Can't create test without entry point");
|
|
|
28 }
|
|
|
29
|
|
|
30 sub UnitName {
|
|
|
31 my ($self) = @_;
|
|
|
32 $self->toString;
|
|
|
33 }
|
|
|
34
|
|
|
35 sub Cleanup {
|
|
|
36 my ($this,$session) = @_;
|
|
|
37
|
|
97
|
38 $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1);
|
|
49
|
39
|
|
|
40 1;
|
|
|
41 }
|
|
|
42
|
|
|
43 sub StartUnit {
|
|
|
44 my $class = shift;
|
|
|
45
|
|
|
46 return {};
|
|
|
47 }
|
|
|
48
|
|
|
49 sub InitTest {
|
|
|
50 my ($this,$session) = @_;
|
|
|
51
|
|
97
|
52 $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1);
|
|
49
|
53 }
|
|
|
54
|
|
|
55 sub FinishUnit {
|
|
|
56 my ($class,$session) = @_;
|
|
|
57
|
|
|
58 1;
|
|
|
59 }
|
|
|
60
|
|
|
61 sub List {
|
|
|
62 my $self = shift;
|
|
|
63
|
|
|
64 return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria
|
|
|
65 }
|
|
|
66
|
|
|
67 sub Run {
|
|
|
68 my ($this,$session) = @_;
|
|
|
69
|
|
|
70 my $t = [gettimeofday];
|
|
|
71 return try {
|
|
|
72 $this->InitTest($session);
|
|
|
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($session);
|
|
|
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;
|
|
166
|
113 use parent qw(IMPL::Object::Meta);
|
|
49
|
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;
|
|
166
|
131 use parent qw(IMPL::Object::Meta);
|
|
49
|
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;
|
