Mercurial > pub > Impl
comparison Lib/IMPL/Test/Unit.pm @ 0:03e58a454b20
Создан репозитарий
author | Sergey |
---|---|
date | Tue, 14 Jul 2009 12:54:37 +0400 |
parents | |
children | 65a7bb156fb7 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:03e58a454b20 |
---|---|
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; |