Mercurial > pub > Impl
annotate Lib/IMPL/Test/BadUnit.pm @ 40:ac21a032e7a9
bnf parser in progress
| author | Sergey |
|---|---|
| date | Thu, 10 Dec 2009 17:43:39 +0300 |
| parents | d59526f6310e |
| children | 16ada169ca75 |
| rev | line source |
|---|---|
| 0 | 1 package IMPL::Test::BadUnit; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 5 use base qw(IMPL::Test::Unit); | |
| 6 use IMPL::Class::Property; | |
| 7 | |
| 8 BEGIN { | |
| 9 public property UnitName => prop_all; | |
| 10 public property Message => prop_all; | |
| 11 public property Error => prop_all; | |
| 12 } | |
| 13 | |
| 14 our %CTOR = ( | |
| 15 'IMPL::Test::Unit' => sub { | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
16 if (@_>1) { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
17 # Unit construction |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
18 my ($unit,$message,$error) = @_; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
19 return new IMPL::Test::Unit::TestInfo( |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
20 BadUnitTest => sub { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
21 die new IMPL::Test::FailException($message,$unit,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error) |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
22 } |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
23 ); |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
24 } else { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
25 # test construction |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
26 return @_; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
27 } |
| 0 | 28 } |
| 29 ); | |
| 30 | |
| 31 sub CTOR { | |
| 32 my ($this,$name,$message,$error) = @_; | |
| 33 | |
| 34 $this->UnitName($name); | |
| 35 $this->Message($message); | |
| 36 $this->Error($error); | |
| 37 } | |
| 38 | |
| 39 sub save { | |
| 40 my ($this,$ctx) = @_; | |
| 41 | |
| 42 defined ($this->$_()) and $ctx->AddVar($_ => $this->$_()) foreach qw(UnitName Message); | |
| 43 } | |
| 44 | |
| 45 sub restore { | |
| 46 my ($class,$data,$inst) = @_; | |
| 47 | |
| 48 my %args = @$data; | |
| 49 | |
| 50 $inst ||= $class->surrogate; | |
| 51 $inst->callCTOR(@args{qw(UnitName Message)}); | |
| 52 } | |
| 53 | |
|
31
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
54 sub List { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
55 my ($this) = @_; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
56 my $error = $this->Error; |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
57 return new IMPL::Test::Unit::TestInfo( |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
58 BadUnitTest => sub { |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
59 die new IMPL::Test::FailException($this->Message,$this->UnitName,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error) |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
60 } |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
61 ); |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
62 } |
|
d59526f6310e
Small fixes to Test framework (correct handlinf of the compilation errors in the test units)
Sergey
parents:
0
diff
changeset
|
63 |
| 0 | 64 |
| 65 1; |