Mercurial > pub > Impl

comparison lib/IMPL/Test/Plan.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::Plan;
2 use strict;
3 use warnings;
4
5 use parent qw(IMPL::Object);
6 use IMPL::Class::Property;
7
8 use IMPL::Exception;
9 use IMPL::Test::Result;
10 use IMPL::Test::BadUnit;
11 use Error qw(:try);
12
13 use IMPL::Serialization;
14 use IMPL::Serialization::XmlFormatter;
15
16 BEGIN {
17 public property Units => prop_all | prop_list;
18 public property Results => prop_all | prop_list;
19 public property Listeners => prop_all | prop_list;
20 private property _Cache => prop_all | prop_list;
21 private property _Count => prop_all;
22 }
23
24 sub CTOR {
25 my $this = shift;
26 $this->Units(\@_);
27 }
28
29 sub restore {
30 my ($class,$data,$instance) = @_;
31
32 $instance ||= $class->surrogate;
33
34 $instance->callCTOR();
35
36 my %args = @$data;
37
38 $instance->Units($args{Units});
39 $instance->Results($args{Results}) if $args{Results};
40 $instance->Listeners($args{Listeners}) if $args{Listeners};
41 }
42
43 sub save {
44 my ($this,$ctx) = @_;
45
46 $ctx->AddVar(Units => [$this->Units]);
47 $ctx->AddVar(Results => [$this->Results]) if $this->Results;
48 $ctx->AddVar(Listeners => [$this->Listeners]) if $this->Listeners;
49 }
50
51 sub AddListener {
52 my ($this,$listener) = @_;
53
54 $this->Listeners($this->Listeners,$listener);
55 }
56
57 sub Prepare {
58 my ($this) = @_;
59
60 my $count = 0;
61 my @cache;
62
63 foreach my $Unit ($this->Units){
64 my %info;
65
66 # preload module
67 undef $@;
68
69 eval "require $Unit" unless (ref $Unit);
70
71 # handle loading errors
72 $Unit = new IMPL::Test::BadUnit($Unit,"Failed to load unit",$@) if $@;
73
74 $info{Unit} = $Unit;
75 try {
76 $info{Tests} = [$Unit->List];
77 } otherwise {
78 my $err = $@;
79 $Unit = $info{Unit} = new IMPL::Test::BadUnit(
80 $Unit->can('UnitName') ?
81 $Unit->UnitName :
82 $Unit,
83 "Failed to extract tests",
84 $err
85 );
86 $info{Tests} = [$Unit->List];
87 };
88 $count += @{$info{Tests}};
89 push @cache, \%info if @{$info{Tests}};
90 }
91
92 $this->_Count($count);
93 $this->_Cache(\@cache);
94 }
95
96 sub Count {
97 my ($this) = @_;
98 return $this->_Count;
99 }
100
101 sub Run {
102 my $this = shift;
103
104 die new IMPL::InvalidOperationException("You must call the prepare method before running the plan") unless $this->_Cache;
105
106 $this->_Tell(RunPlan => $this);
107
108 my @resultsTotal;
109
110 foreach my $info ($this->_Cache) {
111 $this->_Tell(RunUnit => $info->{Unit});
112
113 my $data;
114 undef $@;
115 eval {
116 $data = $info->{Unit}->StartUnit;
117 };
118
119 my @results;
120
121 if (not $@) {
122
123 foreach my $test (@{$info->{Tests}}) {
124 my $name = $test->Name;
125
126 #protected creation of the test
127 $test = eval { $info->{Unit}->new($test); } || new IMPL::Test::BadUnit(
128 $info->{Unit}->can('UnitName') ?
129 $info->{Unit}->UnitName :
130 $info->{Unit},
131 "Failed to construct the test $name",
132 $@
133 );
134
135 # invoke the test
136 $this->_Tell(RunTest => $test);
137 my $result = $test->Run($data);
138 $this->_Tell(EndTest => $test,$result);
139
140 push @results,$result;
141 }
142 } else {
143 my $e = $@;
144 my $badTest = new IMPL::Test::BadUnit(
145 $info->{Unit}->can('UnitName') ?
146 $info->{Unit}->UnitName :
147 $info->{Unit},
148 "Failed to initialize the unit",
149 $@
150 );
151 foreach my $test (@{$info->{Tests}}) {
152
153 $this->_Tell(RunTest => $badTest);
154 my $result = new IMPL::Test::Result(
155 Name => $test->Name,
156 State => IMPL::Test::Result::FAIL,
157 Exception => $e
158 );
159 $this->_Tell(EndTest => $badTest,$result);
160 push @results,$result;
161 }
162 }
163
164 eval {
165 $info->{Unit}->FinishUnit($data);
166 };
167
168 undef $@;
169
170 push @resultsTotal, { Unit => $info->{Unit}, Results => \@results};
171
172 $this->_Tell(EndUnit => $info->{Unit},\@results);
173 }
174
175 $this->Results(\@resultsTotal);
176 $this->_Tell(EndPlan => $this);
177 }
178
179 sub _Tell {
180 my ($this,$what,@args) = @_;
181
182 $_->$what(@args) foreach $this->Listeners;
183 }
184
185 sub SaveXML {
186 my ($this,$out) = @_;
187
188 my $h;
189
190 if (ref $out eq 'GLOB') {
191 $h = $out;
192 } elsif ($out and not ref $out) {
193 open $h, ">", $out or die new IMPL::Exception("Failed to open file",$out);
194 } else {
195 die new IMPL::InvalidOperationException("Invalid output specified");
196 }
197
198 my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
199 $s->Serialize($h,$this);
200 }
201
202 sub LoadXML {
203 my ($self,$in) = @_;
204
205 my $h;
206
207 if (ref $in eq 'GLOB') {
208 $h = $in;
209 } elsif ($in and not ref $in) {
210 open $h, ">", $in or die new IMPL::Exception("Failed to open file",$in);
211 } else {
212 die new IMPL::InvalidOperationException("Invalid input specified");
213 }
214
215 my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
216 return $s->Deserialize($h);
217 }
218
219 sub xml {
220 my $this = shift;
221 my $str = '';
222
223 open my $h,'>',\$str or die new IMPL::Exception("Failed to create stream");
224 $this->SaveXML($h);
225 undef $h;
226 return $str;
227 }
228
229 sub LoadXMLString {
230 my $self = shift;
231 my $str = shift;
232
233 open my $h,'<',\$str or die new IMPL::Exception("Failed to create stream");
234 return $self->LoadXML($h);
235 }
236
237
238 1;