annotate Lib/IMPL/Test/Unit.pm @ 40:ac21a032e7a9

bnf parser in progress
author Sergey
date Thu, 10 Dec 2009 17:43:39 +0300
parents 65a7bb156fb7
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Test::Unit;
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::Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 use Time::HiRes qw(gettimeofday tv_interval);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 use Error qw(:try);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 use IMPL::Test::Result;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 use IMPL::Test::FailException;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 use IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 public property Name => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 public property Code => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 my ($this,$info) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 die new IMPL::InvalidArgumentException("TestInfo should be supplied as an argument") unless $info;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 $this->Name($info->Name || 'Annon');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 $this->Code($info->Code)or die new IMPL::InvalidOperationException("Can't create test without entry point");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 sub UnitName {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 my ($self) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 $self->toString;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 sub Setup {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 sub Cleanup {
14
65a7bb156fb7 Дом модель и схема
Sergey
parents: 0
diff changeset
39 my ($this,$session) = @_;
65a7bb156fb7 Дом модель и схема
Sergey
parents: 0
diff changeset
40
65a7bb156fb7 Дом модель и схема
Sergey
parents: 0
diff changeset
41 $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData');
65a7bb156fb7 Дом модель и схема
Sergey
parents: 0
diff changeset
42
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 sub StartUnit {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 my $class = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 return {};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 sub InitTest {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 my ($this,$session) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 sub FinishUnit {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 my ($class,$session) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 sub List {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 my $self = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67 return $self->get_meta('IMPL::Test::Unit::TestInfo',undef,1); # deep search with no criteria
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70 sub Run {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 my ($this,$session) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73 my $t = [gettimeofday];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 return try {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75 $this->InitTest($session);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76 $this->Setup;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 my $code = $this->Code;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 my $t0 = [gettimeofday];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81 my $elapsed;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 try {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84 $this->$code();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85 $elapsed = tv_interval ( $t0 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 } finally {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87 # we need to call Cleanup anyway
14
65a7bb156fb7 Дом модель и схема
Sergey
parents: 0
diff changeset
88 $this->Cleanup($session);
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89 };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91 return new IMPL::Test::Result(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 Name => $this->Name,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93 State => IMPL::Test::Result::SUCCESS,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94 TimeExclusive => $elapsed,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 TimeInclusive => tv_interval ( $t )
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 } catch IMPL::Test::FailException with {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98 my $e = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99 return new IMPL::Test::Result(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 Name => $this->Name,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 State => IMPL::Test::Result::FAIL,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 Exception => $e,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103 TimeInclusive => tv_interval ( $t )
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105 } otherwise {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106 my $e = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 return new IMPL::Test::Result(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108 Name => $this->Name,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109 State => IMPL::Test::Result::ERROR,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 Exception => $e,
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
111 TimeInclusive => tv_interval ( $t )
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
112 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
113 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
114 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
115
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
116 package IMPL::Test::Unit::TestInfo;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
117 use base qw(IMPL::Object::Meta);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
118 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
119
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
120 require IMPL::Exception;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
121
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
122 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
123 public property Name => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
124 public property Code => prop_all;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
125 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
126
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
127 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 my ($this,$name,$code) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
129
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
130 $this->Name($name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
131 $this->Code($code) or die new IMPL::InvalidArgumentException("The Code is a required parameter");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
132 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
133
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
134 package IMPL::Test::Unit::SharedData;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
135 use base qw(IMPL::Object::Meta);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
136 use IMPL::Class::Property;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
137
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
138 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
139 public property DataList => prop_all | prop_list;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
140 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
141
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
142 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
143 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
144
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
145 $this->DataList(\@_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
146 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
147 1;