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