Mercurial > pub > Impl
diff lib/IMPL/Test/Plan.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children | 9335cf010b23 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/Test/Plan.pm Fri Sep 04 19:40:23 2015 +0300 @@ -0,0 +1,238 @@ +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;