view Lib/IMPL/Test/Unit.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +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;