Mercurial > pub > Impl
view Lib/IMPL/Test/Plan.pm @ 250:129e48bb5afb
DOM refactoring
ObjectToDOM methods are virtual
QueryToDOM uses inflators
Fixed transform for the complex values in the ObjectToDOM
QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author | sergey |
---|---|
date | Wed, 07 Nov 2012 04:17:53 +0400 |
parents | 4d0e1962161c |
children |
line wrap: on
line source
package IMPL::Test::Plan; use strict; use warnings; use parent 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;