annotate lib/IMPL/Test/BadUnit.pm @ 424:87af445663d7 ref20150831

IMPL::Object::_Base
author cin
date Tue, 03 Apr 2018 10:54:09 +0300
parents c6e90e02dd17
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
1 package IMPL::Test::BadUnit;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
2 use strict;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
3 use warnings;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
4
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
5 use parent qw(IMPL::Test::Unit);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
6 use IMPL::Class::Property;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
7
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
8 BEGIN {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
9 public property UnitName => prop_all;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
10 public property Message => prop_all;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
11 public property Error => prop_all;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
12 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
13
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
14 our %CTOR = (
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
15 'IMPL::Test::Unit' => sub {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
16 if (@_>1) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
17 # Unit construction
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
18 my ($unit,$message,$error) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
19 return new IMPL::Test::Unit::TestInfo(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
20 BadUnitTest => sub {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
21 die new IMPL::Test::FailException($message,$unit,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
22 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
23 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
24 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
25 # test construction
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
26 return @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
27 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
28 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
29 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
30
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
31 sub CTOR {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
32 my ($this,$name,$message,$error) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
33
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
34 $this->UnitName($name);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
35 $this->Message($message);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
36 $this->Error($error);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
37 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
38
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
39 sub save {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
40 my ($this,$ctx) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
41
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
42 defined ($this->$_()) and $ctx->AddVar($_ => $this->$_()) foreach qw(UnitName Message);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
43 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
44
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
45 sub restore {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
46 my ($class,$data,$inst) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
47
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
48 my %args = @$data;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
49
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
50 $inst ||= $class->surrogate;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
51 $inst->callCTOR(@args{qw(UnitName Message)});
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
52 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
53
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
54 sub List {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
55 my ($this) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
56 my $error = $this->Error;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
57 return new IMPL::Test::Unit::TestInfo(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
58 BadUnitTest => sub {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
59 die new IMPL::Test::FailException($this->Message,$this->UnitName,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
60 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
61 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
62 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
63
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
64
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
65 1;