Mercurial > pub > Impl
view _test/Test/Object/Fields.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 | eb3e9861a761 |
children | d1676be8afcc |
line wrap: on
line source
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;