annotate Lib/IMPL/Test/BadUnit.pm @ 16:75d55f4ee263

Окончательная концепция описания схем и построения DOM документов
author Sergey
date Tue, 08 Sep 2009 17:29:07 +0400
parents 03e58a454b20
children d59526f6310e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Test::BadUnit;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use warnings;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 use base qw(IMPL::Test::Unit);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 public property UnitName => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 public property Message => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 public property Error => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 our %CTOR = (
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 'IMPL::Test::Unit' => sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 my ($unit,$message,$error) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 return new IMPL::Test::Unit::TestInfo(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 BadUnitTest => sub {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 die new IMPL::Test::FailException($message,$unit,eval {$error->isa('IMPL::Exception')} ? $error->toString(1) : $error)
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 my ($this,$name,$message,$error) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 $this->UnitName($name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 $this->Message($message);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 $this->Error($error);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 sub save {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 my ($this,$ctx) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 defined ($this->$_()) and $ctx->AddVar($_ => $this->$_()) foreach qw(UnitName Message);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 sub restore {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 my ($class,$data,$inst) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 my %args = @$data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 $inst ||= $class->surrogate;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 $inst->callCTOR(@args{qw(UnitName Message)});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 1;