Mercurial > pub > Impl
view Lib/IMPL/Test/Unit.pm @ 239:23daf2fae33a
*security subsytem bugfixes
*HttpResponse: cookies which values are set to undefined will be deleted from browser
author | sergey |
---|---|
date | Tue, 16 Oct 2012 20:14:11 +0400 |
parents | 4d0e1962161c |
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;