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;