diff _test/Test/Object/Fields.pm @ 164:eb3e9861a761

SQL traits in progress
author wizard
date Mon, 28 Mar 2011 01:36:24 +0400
parents
children d1676be8afcc
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Object/Fields.pm	Mon Mar 28 01:36:24 2011 +0400
@@ -0,0 +1,54 @@
+package Test::Object::Fields;
+use strict;
+use warnings;
+
+use base qw( IMPL::Test::Unit );
+use IMPL::Test qw(test failed cmparray);
+
+__PACKAGE__->PassThroughArgs;
+
+{
+	package Fields::Foo;
+	use base qw(IMPL::Object::Fields);
+	
+	use fields qw(name info);
+	
+	sub CTOR {
+		my ($this,$name,$info) = @_;
+		
+		$this->{name} = $name;
+		$this->{info} = $info;
+	}
+	
+	package Fields::Bar;
+	use base qw(Fields::Foo);
+	use fields qw(id);
+	
+	our %CTOR = (
+		'Fields::Foo' => sub {
+			my %args = @_;
+			Bar => $args{info};
+		}
+	);
+	
+	sub CTOR {
+		my ($this,%args) = @_;
+		
+		$this->{id} = $args{id};
+	}
+}
+
+test constructObject => sub {
+	my $obj = new Fields::Foo( Peter => '34-fg-78' );
+	
+	$obj->{name} eq 'Peter' or failed "A value of 'name' field is wrong","Expected: 'Peter'","Got: '$obj->{name}'";
+};
+
+test inheritance => sub {
+	my $obj = new Fields::Bar( id => '1ba356f', info => 'standard bar');
+	
+	$obj->{name} eq 'Bar' or failed "A value of 'name' property is wrong","Expected: 'Bar'","Got: '$obj->{name}'";
+	$obj->{id} eq '1ba356f' or failed "A value of 'id' property is wrong","Expected: '1ba356f'","Got: '$obj->{id}'";
+};
+
+1;
\ No newline at end of file