Mercurial > pub > Impl

comparison _test/Test/Object/Destructors.pm @ 273:ad93c9f4dd93

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