Mercurial > pub > Impl
annotate Lib/IMPL/Test/Plan.pm @ 31:d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Imported and refactored SQL DB schema from the old project
| author | Sergey |
|---|---|
| date | Mon, 09 Nov 2009 01:39:16 +0300 |
| parents | 2e546a5175dd |
| children | 16ada169ca75 |
| rev | line source |
|---|---|
| 0 | 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 | |
| 3 | 66 # preload module |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
3
diff
changeset
|
67 undef $@; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
3
diff
changeset
|
68 |
| 3 | 69 eval "require $Unit" unless (ref $Unit); |
| 70 | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
3
diff
changeset
|
71 # handle loading errors |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
3
diff
changeset
|
72 $Unit = new IMPL::Test::BadUnit($Unit,"Failed to load unit",$@) if $@; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
3
diff
changeset
|
73 |
| 0 | 74 $info{Unit} = $Unit; |
| 75 try { | |
| 76 $info{Tests} = [map $Unit->new($_), $Unit->List]; | |
| 77 } otherwise { | |
| 3 | 78 $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->can('UnitName') ? $Unit->UnitName : $Unit,"Failed to extract tests",$@)]; |
| 0 | 79 }; |
| 80 $count += @{$info{Tests}}; | |
| 81 push @cache, \%info if @{$info{Tests}}; | |
| 82 } | |
| 83 | |
| 84 $this->_Count($count); | |
| 85 $this->_Cache(\@cache); | |
| 86 } | |
| 87 | |
| 88 sub Count { | |
| 89 my ($this) = @_; | |
| 90 return $this->_Count; | |
| 91 } | |
| 92 | |
| 93 sub Run { | |
| 94 my $this = shift; | |
| 95 | |
| 96 die new IMPL::InvalidOperationException("You must call the prepare method before running the plan") unless $this->_Cache; | |
| 97 | |
| 98 $this->_Tell(RunPlan => $this); | |
| 99 | |
| 100 my @resultsTotal; | |
| 101 | |
| 102 foreach my $info ($this->_Cache) { | |
| 103 $this->_Tell(RunUnit => $info->{Unit}); | |
| 104 | |
| 105 my $data; | |
| 106 undef $@; | |
| 107 eval { | |
| 108 $data = $info->{Unit}->StartUnit; | |
| 109 }; | |
| 110 | |
| 111 my @results; | |
| 112 | |
| 113 if (not $@) { | |
| 114 foreach my $test (@{$info->{Tests}}) { | |
| 115 $this->_Tell(RunTest => $test); | |
| 116 my $result = $test->Run($data); | |
| 117 $this->_Tell(EndTest => $test,$result); | |
| 118 push @results,$result; | |
| 119 } | |
| 120 } else { | |
| 121 my $e = $@; | |
| 122 foreach my $test (@{$info->{Tests}}) { | |
| 123 $this->_Tell(RunTest => $test); | |
| 124 my $result = new IMPL::Test::Result( | |
| 125 Name => $test->Name, | |
| 126 State => IMPL::Test::Result::FAIL, | |
| 127 Exception => $e | |
| 128 ); | |
| 129 $this->_Tell(EndTest => $test,$result); | |
| 130 push @results,$result; | |
| 131 } | |
| 132 } | |
| 133 | |
| 134 eval { | |
| 135 $info->{Unit}->FinishUnit($data); | |
| 136 }; | |
| 137 | |
| 138 undef $@; | |
| 139 | |
| 140 push @resultsTotal, { Unit => $info->{Unit}, Results => \@results}; | |
| 141 | |
| 142 $this->_Tell(EndUnit => $info->{Unit},\@results); | |
| 143 } | |
| 144 | |
| 145 $this->Results(\@resultsTotal); | |
| 146 $this->_Tell(EndPlan => $this); | |
| 147 } | |
| 148 | |
| 149 sub _Tell { | |
| 150 my ($this,$what,@args) = @_; | |
| 151 | |
| 152 $_->$what(@args) foreach $this->Listeners; | |
| 153 } | |
| 154 | |
| 155 sub SaveXML { | |
| 156 my ($this,$out) = @_; | |
| 157 | |
| 158 my $h; | |
| 159 | |
| 160 if (ref $out eq 'GLOB') { | |
| 161 $h = $out; | |
| 162 } elsif ($out and not ref $out) { | |
| 163 open $h, ">", $out or die new IMPL::Exception("Failed to open file",$out); | |
| 164 } else { | |
| 165 die new IMPL::InvalidOperationException("Invalid output specified"); | |
| 166 } | |
| 167 | |
| 168 my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) ); | |
| 169 $s->Serialize($h,$this); | |
| 170 } | |
| 171 | |
| 172 sub LoadXML { | |
| 173 my ($self,$in) = @_; | |
| 174 | |
| 175 my $h; | |
| 176 | |
| 177 if (ref $in eq 'GLOB') { | |
| 178 $h = $in; | |
| 179 } elsif ($in and not ref $in) { | |
| 180 open $h, ">", $in or die new IMPL::Exception("Failed to open file",$in); | |
| 181 } else { | |
| 182 die new IMPL::InvalidOperationException("Invalid input specified"); | |
| 183 } | |
| 184 | |
| 185 my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) ); | |
| 186 return $s->Deserialize($h); | |
| 187 } | |
| 188 | |
| 189 sub xml { | |
| 190 my $this = shift; | |
| 191 my $str = ''; | |
| 192 | |
| 193 open my $h,'>',\$str or die new IMPL::Exception("Failed to create stream"); | |
| 194 $this->SaveXML($h); | |
| 195 undef $h; | |
| 196 return $str; | |
| 197 } | |
| 198 | |
| 199 sub LoadXMLString { | |
| 200 my $self = shift; | |
| 201 my $str = shift; | |
| 202 | |
| 203 open my $h,'<',\$str or die new IMPL::Exception("Failed to create stream"); | |
| 204 return $self->LoadXML($h); | |
| 205 } | |
| 206 | |
| 207 | |
| 208 1; |