diff Lib/IMPL/Test/Unit.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 65a7bb156fb7
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Test/Unit.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,143 @@
+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 {
+    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;
+        };
+        
+        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;