Mercurial > pub > Impl
view Lib/IMPL/Test/Plan.pm @ 103:c289ed9662ca
Schema beta 2
More strict validation, support for inflating a simple nodes and properties
author | wizard |
---|---|
date | Fri, 07 May 2010 18:17:40 +0400 |
parents | 74bae30eb25e |
children | 4267a2ac3d46 |
line wrap: on
line source
package IMPL::Test::Plan; use strict; use warnings; use base qw(IMPL::Object); use IMPL::Class::Property; use IMPL::Exception; use IMPL::Test::Result; use IMPL::Test::BadUnit; use Error qw(:try); use IMPL::Serialization; use IMPL::Serialization::XmlFormatter; BEGIN { public property Units => prop_all | prop_list; public property Results => prop_all | prop_list; public property Listeners => prop_all | prop_list; private property _Cache => prop_all | prop_list; private property _Count => prop_all; } sub CTOR { my $this = shift; $this->Units(\@_); } sub restore { my ($class,$data,$instance) = @_; $instance ||= $class->surrogate; $instance->callCTOR(); my %args = @$data; $instance->Units($args{Units}); $instance->Results($args{Results}) if $args{Results}; $instance->Listeners($args{Listeners}) if $args{Listeners}; } sub save { my ($this,$ctx) = @_; $ctx->AddVar(Units => [$this->Units]); $ctx->AddVar(Results => [$this->Results]) if $this->Results; $ctx->AddVar(Listeners => [$this->Listeners]) if $this->Listeners; } sub AddListener { my ($this,$listener) = @_; $this->Listeners($this->Listeners,$listener); } sub Prepare { my ($this) = @_; my $count = 0; my @cache; foreach my $Unit ($this->Units){ my %info; # preload module undef $@; eval "require $Unit" unless (ref $Unit); # handle loading errors $Unit = new IMPL::Test::BadUnit($Unit,"Failed to load unit",$@) if $@; $info{Unit} = $Unit; try { $info{Tests} = [$Unit->List]; } otherwise { my $err = $@; $Unit = $info{Unit} = new IMPL::Test::BadUnit( $Unit->can('UnitName') ? $Unit->UnitName : $Unit, "Failed to extract tests", $err ); $info{Tests} = [$Unit->List]; }; $count += @{$info{Tests}}; push @cache, \%info if @{$info{Tests}}; } $this->_Count($count); $this->_Cache(\@cache); } sub Count { my ($this) = @_; return $this->_Count; } sub Run { my $this = shift; die new IMPL::InvalidOperationException("You must call the prepare method before running the plan") unless $this->_Cache; $this->_Tell(RunPlan => $this); my @resultsTotal; foreach my $info ($this->_Cache) { $this->_Tell(RunUnit => $info->{Unit}); my $data; undef $@; eval { $data = $info->{Unit}->StartUnit; }; my @results; if (not $@) { foreach my $test (@{$info->{Tests}}) { my $name = $test->Name; #protected creation of the test $test = eval { $info->{Unit}->new($test); } || new IMPL::Test::BadUnit( $info->{Unit}->can('UnitName') ? $info->{Unit}->UnitName : $info->{Unit}, "Failed to construct the test $name", $@ ); # invoke the test $this->_Tell(RunTest => $test); my $result = $test->Run($data); $this->_Tell(EndTest => $test,$result); push @results,$result; } } else { my $e = $@; my $badTest = new IMPL::Test::BadUnit( $info->{Unit}->can('UnitName') ? $info->{Unit}->UnitName : $info->{Unit}, "Failed to initialize the unit", $@ ); foreach my $test (@{$info->{Tests}}) { $this->_Tell(RunTest => $badTest); my $result = new IMPL::Test::Result( Name => $test->Name, State => IMPL::Test::Result::FAIL, Exception => $e ); $this->_Tell(EndTest => $badTest,$result); push @results,$result; } } eval { $info->{Unit}->FinishUnit($data); }; undef $@; push @resultsTotal, { Unit => $info->{Unit}, Results => \@results}; $this->_Tell(EndUnit => $info->{Unit},\@results); } $this->Results(\@resultsTotal); $this->_Tell(EndPlan => $this); } sub _Tell { my ($this,$what,@args) = @_; $_->$what(@args) foreach $this->Listeners; } sub SaveXML { my ($this,$out) = @_; my $h; if (ref $out eq 'GLOB') { $h = $out; } elsif ($out and not ref $out) { open $h, ">", $out or die new IMPL::Exception("Failed to open file",$out); } else { die new IMPL::InvalidOperationException("Invalid output specified"); } my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) ); $s->Serialize($h,$this); } sub LoadXML { my ($self,$in) = @_; my $h; if (ref $in eq 'GLOB') { $h = $in; } elsif ($in and not ref $in) { open $h, ">", $in or die new IMPL::Exception("Failed to open file",$in); } else { die new IMPL::InvalidOperationException("Invalid input specified"); } my $s = new IMPL::Serializer(Formatter => new IMPL::Serialization::XmlFormatter( IdentOutput => 1, SkipWhitespace => 1) ); return $s->Deserialize($h); } sub xml { my $this = shift; my $str = ''; open my $h,'>',\$str or die new IMPL::Exception("Failed to create stream"); $this->SaveXML($h); undef $h; return $str; } sub LoadXMLString { my $self = shift; my $str = shift; open my $h,'<',\$str or die new IMPL::Exception("Failed to create stream"); return $self->LoadXML($h); } 1;