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