Mercurial > pub > Impl
comparison Lib/IMPL/Test/Unit.pm @ 0:03e58a454b20
Создан репозитарий
| author | Sergey |
|---|---|
| date | Tue, 14 Jul 2009 12:54:37 +0400 |
| parents | |
| children | 65a7bb156fb7 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:03e58a454b20 |
|---|---|
| 1 package IMPL::Test::Unit; | |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 5 use base qw(IMPL::Object); | |
| 6 use IMPL::Class::Property; | |
| 7 | |
| 8 use Time::HiRes qw(gettimeofday tv_interval); | |
| 9 | |
| 10 use Error qw(:try); | |
| 11 use IMPL::Test::Result; | |
| 12 use IMPL::Test::FailException; | |
| 13 use IMPL::Exception; | |
| 14 | |
| 15 BEGIN { | |
| 16 public property Name => prop_all; | |
| 17 public property Code => prop_all; | |
| 18 } | |
| 19 | |
| 20 sub CTOR { | |
| 21 my ($this,$info) = @_; | |
| 22 | |
| 23 die new IMPL::InvalidArgumentException("TestInfo should be supplied as an argument") unless $info; | |
| 24 | |
| 25 $this->Name($info->Name || 'Annon'); | |
| 26 $this->Code($info->Code)or die new IMPL::InvalidOperationException("Can't create test without entry point"); | |
| 27 } | |
| 28 | |
| 29 sub UnitName { | |
| 30 my ($self) = @_; | |
| 31 $self->toString; | |
| 32 } | |
| 33 | |
| 34 sub Setup { | |
| 35 1; | |
| 36 } | |
| 37 | |
| 38 sub Cleanup { | |
| 39 1; | |
| 40 } | |
| 41 | |
| 42 sub StartUnit { | |
| 43 my $class = shift; | |
| 44 | |
| 45 return {}; | |
| 46 } | |
| 47 | |
| 48 sub InitTest { | |
| 49 my ($this,$session) = @_; | |
| 50 | |
| 51 $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData'); | |
| 52 } | |
| 53 | |
| 54 sub FinishUnit { | |
| 55 my ($class,$session) = @_; | |
| 56 | |
| 57 1; | |
| 58 } | |
| 59 | |
| 60 sub List { | |
| 61 my $self = shift; | |
| 62 | |
| 63 return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria | |
| 64 } | |
| 65 | |
| 66 sub Run { | |
| 67 my ($this,$session) = @_; | |
| 68 | |
| 69 my $t = [gettimeofday]; | |
| 70 return try { | |
| 71 $this->InitTest($session); | |
| 72 $this->Setup; | |
| 73 my $code = $this->Code; | |
| 74 | |
| 75 | |
| 76 my $t0 = [gettimeofday]; | |
| 77 my $elapsed; | |
| 78 | |
| 79 try { | |
| 80 $this->$code(); | |
| 81 $elapsed = tv_interval ( $t0 ); | |
| 82 } finally { | |
| 83 # we need to call Cleanup anyway | |
| 84 $this->Cleanup; | |
| 85 }; | |
| 86 | |
| 87 return new IMPL::Test::Result( | |
| 88 Name => $this->Name, | |
| 89 State => IMPL::Test::Result::SUCCESS, | |
| 90 TimeExclusive => $elapsed, | |
| 91 TimeInclusive => tv_interval ( $t ) | |
| 92 ); | |
| 93 } catch IMPL::Test::FailException with { | |
| 94 my $e = shift; | |
| 95 return new IMPL::Test::Result( | |
| 96 Name => $this->Name, | |
| 97 State => IMPL::Test::Result::FAIL, | |
| 98 Exception => $e, | |
| 99 TimeInclusive => tv_interval ( $t ) | |
| 100 ); | |
| 101 } otherwise { | |
| 102 my $e = shift; | |
| 103 return new IMPL::Test::Result( | |
| 104 Name => $this->Name, | |
| 105 State => IMPL::Test::Result::ERROR, | |
| 106 Exception => $e, | |
| 107 TimeInclusive => tv_interval ( $t ) | |
| 108 ); | |
| 109 } | |
| 110 } | |
| 111 | |
| 112 package IMPL::Test::Unit::TestInfo; | |
| 113 use base qw(IMPL::Object::Meta); | |
| 114 use IMPL::Class::Property; | |
| 115 | |
| 116 require IMPL::Exception; | |
| 117 | |
| 118 BEGIN { | |
| 119 public property Name => prop_all; | |
| 120 public property Code => prop_all; | |
| 121 } | |
| 122 | |
| 123 sub CTOR { | |
| 124 my ($this,$name,$code) = @_; | |
| 125 | |
| 126 $this->Name($name); | |
| 127 $this->Code($code) or die new IMPL::InvalidArgumentException("The Code is a required parameter"); | |
| 128 } | |
| 129 | |
| 130 package IMPL::Test::Unit::SharedData; | |
| 131 use base qw(IMPL::Object::Meta); | |
| 132 use IMPL::Class::Property; | |
| 133 | |
| 134 BEGIN { | |
| 135 public property DataList => prop_all | prop_list; | |
| 136 } | |
| 137 | |
| 138 sub CTOR { | |
| 139 my $this = shift; | |
| 140 | |
| 141 $this->DataList(\@_); | |
| 142 } | |
| 143 1; |
