Mercurial > pub > Impl

comparison Lib/IMPL/Test/Plan.pm @ 0:03e58a454b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 2e546a5175dd
comparison
equal deleted inserted replaced
-1:000000000000 0:03e58a454b20
1 package IMPL::Test::Plan;
2 use strict;
3 use warnings;
4
5 use base 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 $info{Unit} = $Unit;
67 try {
68 $info{Tests} = [map $Unit->new($_), $Unit->List];
69 } otherwise {
70 $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->UnitName,"Failed to extract tests",$@)];
71 };
72 $count += @{$info{Tests}};
73 push @cache, \%info if @{$info{Tests}};
74 }
75
76 $this->_Count($count);
77 $this->_Cache(\@cache);
78 }
79
80 sub Count {
81 my ($this) = @_;
82 return $this->_Count;
83 }
84
85 sub Run {
86 my $this = shift;
87
88 die new IMPL::InvalidOperationException("You must call the prepare method before running the plan") unless $this->_Cache;
89
90 $this->_Tell(RunPlan => $this);
91
92 my @resultsTotal;
93
94 foreach my $info ($this->_Cache) {
95 $this->_Tell(RunUnit => $info->{Unit});
96
97 my $data;
98 undef $@;
99 eval {
100 $data = $info->{Unit}->StartUnit;
101 };
102
103 my @results;
104
105 if (not $@) {
106 foreach my $test (@{$info->{Tests}}) {
107 $this->_Tell(RunTest => $test);
108 my $result = $test->Run($data);
109 $this->_Tell(EndTest => $test,$result);
110 push @results,$result;
111 }
112 } else {
113 my $e = $@;
114 foreach my $test (@{$info->{Tests}}) {
115 $this->_Tell(RunTest => $test);
116 my $result = new IMPL::Test::Result(
117 Name => $test->Name,
118 State => IMPL::Test::Result::FAIL,
119 Exception => $e
120 );
121 $this->_Tell(EndTest => $test,$result);
122 push @results,$result;
123 }
124 }
125
126 eval {
127 $info->{Unit}->FinishUnit($data);
128 };
129
130 undef $@;
131
132 push @resultsTotal, { Unit => $info->{Unit}, Results => \@results};
133
134 $this->_Tell(EndUnit => $info->{Unit},\@results);
135 }
136
137 $this->Results(\@resultsTotal);
138 $this->_Tell(EndPlan => $this);
139 }
140
141 sub _Tell {
142 my ($this,$what,@args) = @_;
143
144 $_->$what(@args) foreach $this->Listeners;
145 }
146
147 sub SaveXML {
148 my ($this,$out) = @_;
149
150 my $h;
151
152 if (ref $out eq 'GLOB') {
153 $h = $out;
154 } elsif ($out and not ref $out) {
155 open $h, ">", $out or die new IMPL::Exception("Failed to open file",$out);
156 } else {
157 die new IMPL::InvalidOperationException("Invalid output specified");
158 }
159
160 my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
161 $s->Serialize($h,$this);
162 }
163
164 sub LoadXML {
165 my ($self,$in) = @_;
166
167 my $h;
168
169 if (ref $in eq 'GLOB') {
170 $h = $in;
171 } elsif ($in and not ref $in) {
172 open $h, ">", $in or die new IMPL::Exception("Failed to open file",$in);
173 } else {
174 die new IMPL::InvalidOperationException("Invalid input specified");
175 }
176
177 my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) );
178 return $s->Deserialize($h);
179 }
180
181 sub xml {
182 my $this = shift;
183 my $str = '';
184
185 open my $h,'>',\$str or die new IMPL::Exception("Failed to create stream");
186 $this->SaveXML($h);
187 undef $h;
188 return $str;
189 }
190
191 sub LoadXMLString {
192 my $self = shift;
193 my $str = shift;
194
195 open my $h,'<',\$str or die new IMPL::Exception("Failed to create stream");
196 return $self->LoadXML($h);
197 }
198
199
200 1;