Mercurial > pub > Impl

annotate _test/Test/Object/Destructors.pm @ 402:b79081b70a7a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fixed error handler templates env
author cin
date Mon, 19 May 2014 18:33:52 +0400
parents ad93c9f4dd93
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
273
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
1 package Test::Object::Destructors;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
2 use strict;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
3
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
4 use IMPL::Test qw(test assert cmparray);
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
5
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
6 use IMPL::declare {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
7 base => [
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
8 'IMPL::Test::Unit' => '@_'
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
9 ]
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
10 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
11
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
12 {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
13 package Test::Object::Destructors::Foo;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
14 use IMPL::Const qw(:prop);
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
15 use IMPL::declare {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
16 base => [
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
17 'IMPL::Object' => undef
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
18 ],
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
19 props => [
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
20 trace => PROP_RO
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
21 ]
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
22 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
23
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
24 sub CTOR {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
25 my ($this,$trace) = @_;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
26
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
27 $this->trace($trace);
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
28 }
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
29
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
30 sub DTOR {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
31 shift->Trace("Foo");
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
32 }
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
33
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
34 sub Trace {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
35 my $this = shift;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
36 push @{$this->trace||[]}, join ' ', @_;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
37 }
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
38
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
39 package Test::Object::Destructors::Bar;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
40 use IMPL::declare {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
41 base => [
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
42 '-Test::Object::Destructors::Foo' => '@_'
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
43 ]
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
44 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
45
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
46
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
47 sub DTOR {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
48 shift->Trace("Bar");
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
49 }
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
50
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
51 package Test::Object::Destructors::Boss;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
52 use IMPL::declare {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
53 base => [
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
54 '-Test::Object::Destructors::Bar' => '@_',
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
55 '-Test::Object::Destructors::Foo' => '@_',
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
56 ]
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
57 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
58
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
59 sub DTOR {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
60 shift->Trace("Boss");
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
61 }
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
62 }
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
63
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
64 use constant {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
65 Foo => 'Test::Object::Destructors::Foo',
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
66 Bar => 'Test::Object::Destructors::Bar',
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
67 Boss => 'Test::Object::Destructors::Boss'
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
68 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
69
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
70 test ObjectHasDestructor => sub {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
71 my @expected = qw( Foo );
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
72 my @trace;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
73 {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
74 my $foo = Foo->new(\@trace);
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
75 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
76 assert(
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
77 cmparray(\@expected,\@trace),
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
78 "Wrong destructors sequence",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
79 "expected: ",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
80 join(", ",@expected),
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
81 "got: ",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
82 join(", ", @trace)
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
83 );
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
84 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
85
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
86 test InheritanceWithDestructor => sub {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
87 my @expected = qw( Bar Foo );
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
88 my @trace;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
89 {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
90 my $bar = Bar->new(\@trace);
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
91 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
92 assert(
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
93 cmparray(\@expected,\@trace),
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
94 "Wrong destructors sequence",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
95 "expected: ",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
96 join(", ",@expected),
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
97 "got: ",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
98 join(", ", @trace)
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
99 );
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
100 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
101
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
102 test MultipleInheritanceWithDestructor => sub {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
103 my @expected = qw( Boss Bar Foo Foo );
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
104 my @trace;
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
105 {
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
106 my $boss = Boss->new(\@trace);
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
107 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
108 assert(
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
109 cmparray(\@expected,\@trace),
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
110 "Wrong destructors sequence",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
111 "expected: ",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
112 join(", ",@expected),
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
113 "got: ",
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
114 join(", ", @trace)
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
115 );
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
116 };
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
117
ad93c9f4dd93 +Added support for destructors, (special method named DTOR)
sergey
parents:
diff changeset
118 1;