Mercurial > pub > Impl
view Lib/IMPL/Test/Unit.pm @ 40:ac21a032e7a9
bnf parser in progress
author | Sergey |
---|---|
date | Thu, 10 Dec 2009 17:43:39 +0300 |
parents | 65a7bb156fb7 |
children | 16ada169ca75 |
line wrap: on
line source
package IMPL::Test::Unit; use strict; use warnings; use base qw(IMPL::Object); use IMPL::Class::Property; use Time::HiRes qw(gettimeofday tv_interval); use Error qw(:try); use IMPL::Test::Result; use IMPL::Test::FailException; use IMPL::Exception; BEGIN { public property Name => prop_all; public property Code => prop_all; } sub CTOR { my ($this,$info) = @_; die new IMPL::InvalidArgumentException("TestInfo should be supplied as an argument") unless $info; $this->Name($info->Name || 'Annon'); $this->Code($info->Code)or die new IMPL::InvalidOperationException("Can't create test without entry point"); } sub UnitName { my ($self) = @_; $self->toString; } sub Setup { 1; } sub Cleanup { my ($this,$session) = @_; $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData'); 1; } sub StartUnit { my $class = shift; return {}; } sub InitTest { my ($this,$session) = @_; $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData'); } sub FinishUnit { my ($class,$session) = @_; 1; } sub List { my $self = shift; return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria } sub Run { my ($this,$session) = @_; my $t = [gettimeofday]; return try { $this->InitTest($session); $this->Setup; my $code = $this->Code; my $t0 = [gettimeofday]; my $elapsed; try { $this->$code(); $elapsed = tv_interval ( $t0 ); } finally { # we need to call Cleanup anyway $this->Cleanup($session); }; return new IMPL::Test::Result( Name => $this->Name, State => IMPL::Test::Result::SUCCESS, TimeExclusive => $elapsed, TimeInclusive => tv_interval ( $t ) ); } catch IMPL::Test::FailException with { my $e = shift; return new IMPL::Test::Result( Name => $this->Name, State => IMPL::Test::Result::FAIL, Exception => $e, TimeInclusive => tv_interval ( $t ) ); } otherwise { my $e = shift; return new IMPL::Test::Result( Name => $this->Name, State => IMPL::Test::Result::ERROR, Exception => $e, TimeInclusive => tv_interval ( $t ) ); } } package IMPL::Test::Unit::TestInfo; use base qw(IMPL::Object::Meta); use IMPL::Class::Property; require IMPL::Exception; BEGIN { public property Name => prop_all; public property Code => prop_all; } sub CTOR { my ($this,$name,$code) = @_; $this->Name($name); $this->Code($code) or die new IMPL::InvalidArgumentException("The Code is a required parameter"); } package IMPL::Test::Unit::SharedData; use base qw(IMPL::Object::Meta); use IMPL::Class::Property; BEGIN { public property DataList => prop_all | prop_list; } sub CTOR { my $this = shift; $this->DataList(\@_); } 1;