view _test/Test/Class/Template.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents
children d1676be8afcc
line wrap: on
line source

package Test::Class::Template;
use strict;
use warnings;

use parent qw(IMPL::Test::Unit);

__PACKAGE__->PassThroughArgs;

use IMPL::Test qw(test failed);
use IMPL::lang;

{
	package My::Collection;
	use parent qw(IMPL::Object);
	use IMPL::Class::Property;
	
	use IMPL::template (
		parameters => [qw(TValue)],
		declare => sub {
			my ($class) = @_;
			
			public $class->CreateProperty( items => prop_get | owner_set | prop_list, { type => $class->TValue } );
		}
	);
	
	BEGIN {
		public property name => prop_all;
	}
};

test IsDerivedFromTemplate => sub {
	failed "My::Collection should be a subclass of IMPL::Class:Template" unless is('My::Collection','IMPL::Class::Template'); 
};

test Specialize => sub {
	my $colList = spec My::Collection('IMPL::Object::List');
	my $colObj = spec My::Collection('IMPL::Object');
	my $colList2 = spec My::Collection('IMPL::Object::List');
	
	failed "Wrong class name", "expected: My::ColectionLis", "got: $colList" unless $colList eq 'My::CollectionList';
	failed "Wrong template parameter type", "expected: IMPL::Object::List", "got" . $colList->TValue unless $colList->TValue eq 'IMPL::Object::List';
	
};

1;