diff lib/IMPL/Test/Unit.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children 9335cf010b23
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Test/Unit.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,158 @@
+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;