Mercurial > pub > Impl
changeset 273:ad93c9f4dd93
+Added support for destructors, (special method named DTOR)
author | sergey |
---|---|
date | Tue, 29 Jan 2013 17:19:10 +0400 |
parents | 47db27ed5b43 |
children | 8d36073411b1 |
files | Lib/IMPL/Object/Abstract.pm Lib/IMPL/Object/Disposable.pm _test/Test/Object/Destructors.pm _test/object.t |
diffstat | 4 files changed, 167 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Object/Abstract.pm Mon Jan 28 17:24:37 2013 +0400 +++ b/Lib/IMPL/Object/Abstract.pm Tue Jan 29 17:19:10 2013 +0400 @@ -63,6 +63,50 @@ $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)}; } +sub _init_dtor { + my ($class) = @_; + + no strict 'refs'; + + # avoid warnings for classes without destructors + no warnings 'once'; + + my @dtors; + + my @hierarchy = ($class); + my %visited; + + while(my $subclass = shift @hierarchy) { + if(*{"${subclass}::DTOR"}{CODE}) { + push @dtors, *{"${subclass}::DTOR"}{CODE}; + } + + push @hierarchy, @{"${subclass}::ISA"}; + } + + if (@dtors) { + + return *{"${class}::callDTOR"} = sub { + my ($self) = @_; + my $selfClass = ref $self; + if ($selfClass ne $class) { + goto &{$selfClass->_init_dtor()}; + } else { + map $_->($self), @dtors; + } + } + + } else { + return *{"${class}::callDTOR"} = sub { + my $self = ref $_[0]; + + goto &{$self->_init_dtor()} unless $self eq $class; + } + } +} + +__PACKAGE__->_init_dtor(); + sub toString { my $self = shift; @@ -77,12 +121,9 @@ 0; } -#sub DESTROY { -# if ($MemoryLeakProtection and $Cleanup) { -# my $this = shift; -# warn sprintf("Object leaks: %s of type %s %s",$this->can('ToString') ? $this->ToString : $this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : ''); -# } -#} +sub DESTROY { + shift->callDTOR(); +} sub END { $Cleanup = 1;
--- a/Lib/IMPL/Object/Disposable.pm Mon Jan 28 17:24:37 2013 +0400 +++ b/Lib/IMPL/Object/Disposable.pm Tue Jan 29 17:19:10 2013 +0400 @@ -9,7 +9,7 @@ bless $this, 'IMPL::Object::Disposed'; } -sub DESTROY { +sub DTOR { my ($this) = @_; warn sprintf('The object %s were marked as disposable but isn\'t disposed properly', $this->can('ToString') ? $this->ToString() : (ref $this || $this) );
--- /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