Mercurial > pub > Impl

comparison lib/IMPL/Test/Unit.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children 9335cf010b23
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::Test::Unit;
2 use strict;
3 use warnings;
4
5 use parent 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 Carp qw(carp);
12 use File::Spec();
13 use IMPL::Test::Result();
14 use IMPL::Test::FailException();
15 use IMPL::Exception();
16
17 BEGIN {
18 public property Name => prop_all;
19 public property Code => prop_all;
20 }
21
22 sub CTOR {
23 my ($this,$info) = @_;
24
25 die new IMPL::InvalidArgumentException("TestInfo should be supplied as an argument") unless $info;
26
27 $this->Name($info->Name || 'Annon');
28 $this->Code($info->Code)or die new IMPL::InvalidOperationException("Can't create test without entry point");
29 }
30
31 sub UnitName {
32 my ($self) = @_;
33 $self->toString;
34 }
35
36 sub Cleanup {
37 my ($this,$session) = @_;
38
39 $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1);
40
41 1;
42 }
43
44 sub StartUnit {
45 my $class = shift;
46
47 return {};
48 }
49
50 sub InitTest {
51 my ($this,$session) = @_;
52
53 $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1);
54 }
55
56 sub FinishUnit {
57 my ($class,$session) = @_;
58
59 1;
60 }
61
62 sub List {
63 my $self = shift;
64
65 return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria
66 }
67
68 sub Run {
69 my ($this,$session) = @_;
70
71 my $t = [gettimeofday];
72 return try {
73 $this->InitTest($session);
74 my $code = $this->Code;
75
76
77 my $t0 = [gettimeofday];
78 my $elapsed;
79
80 try {
81 $this->$code();
82 $elapsed = tv_interval ( $t0 );
83 } finally {
84 # we need to call Cleanup anyway
85 $this->Cleanup($session);
86 };
87
88 return new IMPL::Test::Result(
89 Name => $this->Name,
90 State => IMPL::Test::Result::SUCCESS,
91 TimeExclusive => $elapsed,
92 TimeInclusive => tv_interval ( $t )
93 );
94 } catch IMPL::Test::FailException with {
95 my $e = shift;
96 return new IMPL::Test::Result(
97 Name => $this->Name,
98 State => IMPL::Test::Result::FAIL,
99 Exception => $e,
100 TimeInclusive => tv_interval ( $t )
101 );
102 } otherwise {
103 my $e = shift;
104 return new IMPL::Test::Result(
105 Name => $this->Name,
106 State => IMPL::Test::Result::ERROR,
107 Exception => $e,
108 TimeInclusive => tv_interval ( $t )
109 );
110 }
111 }
112
113 sub GetResourceFile {
114 my ($this,@path) = @_;
115
116 my ($cwd) = map m/(.*)/, File::Spec->rel2abs(File::Spec->curdir());
117 return File::Spec->catfile($cwd,@path);
118 }
119
120 sub GetResourceDir {
121 my ($this,@path) = @_;
122
123 my ($cwd) = map m/(.*)/, File::Spec->rel2abs(File::Spec->curdir());
124 return File::Spec->catdir($cwd,@path);
125 }
126
127 package IMPL::Test::Unit::TestInfo;
128 use parent qw(IMPL::Object::Meta);
129 use IMPL::Class::Property;
130
131 require IMPL::Exception;
132
133 BEGIN {
134 public property Name => prop_all;
135 public property Code => prop_all;
136 }
137
138 sub CTOR {
139 my ($this,$name,$code) = @_;
140
141 $this->Name($name);
142 $this->Code($code) or die new IMPL::InvalidArgumentException("The Code is a required parameter");
143 }
144
145 package IMPL::Test::Unit::SharedData;
146 use parent qw(IMPL::Object::Meta);
147 use IMPL::Class::Property;
148
149 BEGIN {
150 public property DataList => prop_all | prop_list;
151 }
152
153 sub CTOR {
154 my $this = shift;
155
156 $this->DataList(\@_);
157 }
158 1;