Mercurial > pub > Impl
view lib/IMPL/Test/Unit.pm @ 424:87af445663d7 ref20150831
IMPL::Object::_Base
author | cin |
---|---|
date | Tue, 03 Apr 2018 10:54:09 +0300 |
parents | 9335cf010b23 |
children |
line wrap: on
line source
package IMPL::Test::Unit; use strict; use warnings; use parent qw(IMPL::Object); use IMPL::Class::Property; use Time::HiRes qw(gettimeofday tv_interval); use Error qw(:try); use Carp qw(carp); use File::Spec(); 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 Cleanup { my ($this,$session) = @_; $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1); 1; } sub StartUnit { my $class = shift; return {}; } sub InitTest { my ($this,$session) = @_; $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1); } 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); 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 ) ); } } sub GetResourceFile { my ($this,@path) = @_; my ($cwd) = map m/(.*)/, File::Spec->rel2abs(File::Spec->curdir()); return File::Spec->catfile($cwd,@path); } sub GetResourceDir { my ($this,@path) = @_; my ($cwd) = map m/(.*)/, File::Spec->rel2abs(File::Spec->curdir()); return File::Spec->catdir($cwd,@path); } package IMPL::Test::Unit::TestInfo; use parent 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 parent qw(IMPL::Object::Meta); use IMPL::Class::Property; BEGIN { public property DataList => prop_all | prop_list; } sub CTOR { my $this = shift; $this->DataList(\@_); } 1;