|
407
|
1 package IMPL::Test::BadUnit;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use parent 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 {
|
|
|
16 if (@_>1) {
|
|
|
17 # Unit construction
|
|
|
18 my ($unit,$message,$error) = @_;
|
|
|
19 return new IMPL::Test::Unit::TestInfo(
|
|
|
20 BadUnitTest => sub {
|
|
|
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 }
|
|
|
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
|
|
|
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
|
|
|
64
|
|
|
65 1;
|
