49
+ − 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 {
+ − 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;