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;