view Lib/IMPL/Test/Unit.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children 74bae30eb25e
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;