diff _test/Test/Object/Common.pm @ 381:ced5937ff21a

Custom getters/setters support method names in theirs definitions Initial support for localizable labels in DOM schemas
author cin
date Wed, 22 Jan 2014 16:56:10 +0400
parents 76515373dac0
children
line wrap: on
line diff
--- a/_test/Test/Object/Common.pm	Fri Jan 17 15:58:57 2014 +0400
+++ b/_test/Test/Object/Common.pm	Wed Jan 22 16:56:10 2014 +0400
@@ -2,10 +2,12 @@
 use strict;
 use warnings;
 
-use parent qw( IMPL::Test::Unit );
-use IMPL::Test qw(test failed cmparray);
-
-__PACKAGE__->PassThroughArgs;
+use IMPL::Test qw(test failed cmparray assert);
+use IMPL::declare {
+	base => [
+		'IMPL::Test::Unit' => '@_' 
+	]
+};
 
 {
     package Foo;
@@ -103,4 +105,36 @@
     failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected;
 };
 
+test CustomGetterSetter => sub {
+	my $obj = Test::Object::Common::Bar->new();
+	
+	assert($obj->custom eq 'default');
+	$obj->custom('new_value');
+	assert($obj->custom eq 'new_value');
+};
+
+package Test::Object::Common::Bar;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	base => [
+		'IMPL::Object' => undef
+	],
+	props => [
+		custom => {
+			get => '_getCustom',
+			set => '_setCustom',
+			direct => 1
+		}
+	]
+};
+
+sub _getCustom {
+	shift->{$custom} || 'default';
+}
+
+sub _setCustom {
+	my ($this,$value) = @_;
+	$this->{$custom} = $value;
+}
+
 1;