comparison Lib/IMPL/Test/BadUnit.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
comparison
equal deleted inserted replaced
30:dd4d72600c69 31:d59526f6310e
11 public property Error => prop_all; 11 public property Error => prop_all;
12 } 12 }
13 13
14 our %CTOR = ( 14 our %CTOR = (
15 'IMPL::Test::Unit' => sub { 15 'IMPL::Test::Unit' => sub {
16 my ($unit,$message,$error) = @_; 16 if (@_>1) {
17 return new IMPL::Test::Unit::TestInfo( 17 # Unit construction
18 BadUnitTest => sub { 18 my ($unit,$message,$error) = @_;
19 die new IMPL::Test::FailException($message,$unit,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error) 19 return new IMPL::Test::Unit::TestInfo(
20 } 20 BadUnitTest => sub {
21 ); 21 die new IMPL::Test::FailException($message,$unit,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
22 }
23 );
24 } else {
25 # test construction
26 return @_;
27 }
22 } 28 }
23 ); 29 );
24 30
25 sub CTOR { 31 sub CTOR {
26 my ($this,$name,$message,$error) = @_; 32 my ($this,$name,$message,$error) = @_;
43 49
44 $inst ||= $class->surrogate; 50 $inst ||= $class->surrogate;
45 $inst->callCTOR(@args{qw(UnitName Message)}); 51 $inst->callCTOR(@args{qw(UnitName Message)});
46 } 52 }
47 53
54 sub List {
55 my ($this) = @_;
56 my $error = $this->Error;
57 return new IMPL::Test::Unit::TestInfo(
58 BadUnitTest => sub {
59 die new IMPL::Test::FailException($this->Message,$this->UnitName,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
60 }
61 );
62 }
63
48 64
49 1; 65 1;