Mercurial > pub > Impl
diff _test/Test/Object/Destructors.pm @ 273:ad93c9f4dd93
+Added support for destructors, (special method named DTOR)
author | sergey |
---|---|
date | Tue, 29 Jan 2013 17:19:10 +0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Test/Object/Destructors.pm Tue Jan 29 17:19:10 2013 +0400 @@ -0,0 +1,118 @@ +package Test::Object::Destructors; +use strict; + +use IMPL::Test qw(test assert cmparray); + +use IMPL::declare { + base => [ + 'IMPL::Test::Unit' => '@_' + ] +}; + +{ + package Test::Object::Destructors::Foo; + use IMPL::Const qw(:prop); + use IMPL::declare { + base => [ + 'IMPL::Object' => undef + ], + props => [ + trace => PROP_RO + ] + }; + + sub CTOR { + my ($this,$trace) = @_; + + $this->trace($trace); + } + + sub DTOR { + shift->Trace("Foo"); + } + + sub Trace { + my $this = shift; + push @{$this->trace||[]}, join ' ', @_; + } + + package Test::Object::Destructors::Bar; + use IMPL::declare { + base => [ + '-Test::Object::Destructors::Foo' => '@_' + ] + }; + + + sub DTOR { + shift->Trace("Bar"); + } + + package Test::Object::Destructors::Boss; + use IMPL::declare { + base => [ + '-Test::Object::Destructors::Bar' => '@_', + '-Test::Object::Destructors::Foo' => '@_', + ] + }; + + sub DTOR { + shift->Trace("Boss"); + } +} + +use constant { + Foo => 'Test::Object::Destructors::Foo', + Bar => 'Test::Object::Destructors::Bar', + Boss => 'Test::Object::Destructors::Boss' +}; + +test ObjectHasDestructor => sub { + my @expected = qw( Foo ); + my @trace; + { + my $foo = Foo->new(\@trace); + }; + assert( + cmparray(\@expected,\@trace), + "Wrong destructors sequence", + "expected: ", + join(", ",@expected), + "got: ", + join(", ", @trace) + ); +}; + +test InheritanceWithDestructor => sub { + my @expected = qw( Bar Foo ); + my @trace; + { + my $bar = Bar->new(\@trace); + }; + assert( + cmparray(\@expected,\@trace), + "Wrong destructors sequence", + "expected: ", + join(", ",@expected), + "got: ", + join(", ", @trace) + ); +}; + +test MultipleInheritanceWithDestructor => sub { + my @expected = qw( Boss Bar Foo Foo ); + my @trace; + { + my $boss = Boss->new(\@trace); + }; + assert( + cmparray(\@expected,\@trace), + "Wrong destructors sequence", + "expected: ", + join(", ",@expected), + "got: ", + join(", ", @trace) + ); +}; + +1; \ No newline at end of file