Mercurial > pub > Impl
view Lib/IMPL/Test/Unit.pm @ 103:c289ed9662ca
Schema beta 2
More strict validation, support for inflating a simple nodes and properties
author | wizard |
---|---|
date | Fri, 07 May 2010 18:17:40 +0400 |
parents | 964587c5183c |
children | f8de52d3c112 |
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 Carp qw(carp); 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',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); $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;