Mercurial > pub > Impl
changeset 3:2e546a5175dd
in developing
author | Sergey |
---|---|
date | Tue, 11 Aug 2009 17:45:52 +0400 |
parents | 78cd38551534 |
children | e59f44f75f20 |
files | Lib/IMPL/Object/List.pm Lib/IMPL/Test.pm Lib/IMPL/Test/Plan.pm _test/Test/Object/Common.pm _test/Test/Object/List.pm _test/object.t impl.kpf |
diffstat | 7 files changed, 186 insertions(+), 26 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Object/List.pm Mon Aug 10 17:39:08 2009 +0400 +++ b/Lib/IMPL/Object/List.pm Tue Aug 11 17:45:52 2009 +0400 @@ -3,11 +3,21 @@ use warnings; use base qw(IMPL::Object::ArrayObject); +use IMPL::Exception; sub as_list { return $_[0]; } +sub CTOR { + my ($this,$data) = @_; + + if ($data) { + die new IMPL::InvalidArgumentException("The parameter should be a reference to an array") unless UNIVERSAL::isa($data,"ARRAY"); + @$this = @$data; + } +} + sub Append { push @{$_[0]}, @_{1 .. @$_-1}; }
--- a/Lib/IMPL/Test.pm Mon Aug 10 17:39:08 2009 +0400 +++ b/Lib/IMPL/Test.pm Tue Aug 11 17:45:52 2009 +0400 @@ -4,7 +4,7 @@ require Exporter; our @ISA = qw(Exporter); -our @EXPORT_OK = qw(&test &shared); +our @EXPORT_OK = qw(&test &shared &failed &cmparray); require IMPL::Test::Unit; use IMPL::Class::Member; @@ -29,4 +29,20 @@ $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->Name)); } + +sub failed($;@) { + die new IMPL::Test::FailException(@_); +} + +sub cmparray { + my ($a,$b) = @_; + + return 0 unless @$a == @$b; + + for (my $i=0; $i < @$a; $i++ ) { + return 0 unless $a->[$i] eq $b->[$i]; + } + + return 1; +} 1;
--- a/Lib/IMPL/Test/Plan.pm Mon Aug 10 17:39:08 2009 +0400 +++ b/Lib/IMPL/Test/Plan.pm Tue Aug 11 17:45:52 2009 +0400 @@ -63,11 +63,14 @@ foreach my $Unit ($this->Units){ my %info; + # preload module + eval "require $Unit" unless (ref $Unit); + $info{Unit} = $Unit; try { $info{Tests} = [map $Unit->new($_), $Unit->List]; } otherwise { - $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->UnitName,"Failed to extract tests",$@)]; + $info{Tests} = [$info{Unit} = new IMPL::Test::BadUnit($Unit->can('UnitName') ? $Unit->UnitName : $Unit,"Failed to extract tests",$@)]; }; $count += @{$info{Tests}}; push @cache, \%info if @{$info{Tests}};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Test/Object/Common.pm Tue Aug 11 17:45:52 2009 +0400 @@ -0,0 +1,106 @@ +package Test::Object::Common; +use strict; +use warnings; + +use base qw( IMPL::Test::Unit ); +use IMPL::Test qw(test failed cmparray); + +__PACKAGE__->PassThroughArgs; + +{ + package Foo; + use base qw(IMPL::Object); + + sub CTOR { + my ($this,$refarg) = @_; + $$refarg = 1; + } + + package Bar; + use base qw(Foo); + + __PACKAGE__->PassThroughArgs; + + sub CTOR { + my ($this,$ref,$array) = @_; + + push @$array,__PACKAGE__; + } + + package Baz; + use base qw(Bar); + + our %CTOR = ( + Bar => sub { + my $t; + (\$t,$_[0]); + } + ); + + sub CTOR { + my ($this,$array) = @_; + push @$array,__PACKAGE__; + } + + package Zoo; + use base qw(Bar); + + __PACKAGE__->PassThroughArgs; + + sub CTOR { + my ($this,$ref,$array) = @_; + + push @$array,__PACKAGE__; + }; + + package Complex; + use base qw(Baz Zoo); + + our %CTOR = ( + Baz => sub { @_ }, + Zoo => sub { + my $t; + (\$t,$_[0]); + } + ); + +} + +test Creation => sub { + my $flag = 0; + + my $obj = new Foo(\$flag); + + die new IMPL::Test::FailException("Object is undef") unless $obj; + die new IMPL::Test::FailException("Contructor doesn't run") unless $obj; +}; + +test SimpleInheritance => sub { + my $sequence = []; + my $flag = 0; + my $obj = new Bar(\$flag,$sequence); + + failed "Object is undef" unless $obj; + failed "Base class constructor isn't called" unless $flag; + failed "Class constructor isn't called" unless @$sequence; +}; + +test SimpleInheritance2 => sub { + my $sequence = []; + my $expected = [qw(Bar Baz)]; + my $obj = new Baz($sequence); + + failed "Object is undef" unless $obj; + failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected; +}; + +test MultipleInheritance => sub { + my $sequence = []; + my $expected = [qw(Bar Baz Bar Zoo)]; + my $obj = new Complex($sequence); + + failed "Object is undef" unless $obj; + failed "Wrong constructor sequence","expected: " . join(', ',@$expected),"actual: ".join(', ',@$sequence) unless cmparray $sequence,$expected; +}; + +1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Test/Object/List.pm Tue Aug 11 17:45:52 2009 +0400 @@ -0,0 +1,32 @@ +package Test::Object::List; +use strict; +use warnings; + +use base qw(IMPL::Test::Unit); +use IMPL::Test qw(test cmparray failed); +use IMPL::Object::List; +__PACKAGE__->PassThroughArgs; + +test Creation => sub { + my $list = new IMPL::Object::List(); + + failed "Failed to create an empty list" unless $list; +}; + +test FilledByRef => sub { + my $data = [map rand 100, 1 .. 300]; + my $list = new IMPL::Object::List($data); + + failed("List filled incorrectlty") unless cmparray($data,$list); +}; + +test FilledByWrongRef => sub { + eval { + my $list = new IMPL::Object::List({}); + }; + unless ($@) { + failed("List can be initialized only by an ARRAY reference"); + } +}; + +1;
--- a/_test/object.t Mon Aug 10 17:39:08 2009 +0400 +++ b/_test/object.t Tue Aug 11 17:45:52 2009 +0400 @@ -1,30 +1,16 @@ #!/usr/bin/perl -w use strict; use lib '../Lib'; - -package Foo; -use base qw(IMPL::Object); +use lib '.'; -sub CTOR { - my ($this,%args) = @_; - print "CTOR Foo says $args{Name}\n"; -} - -sub Hello { - print "\tHello\n"; -} +use IMPL::Test::Plan; +use IMPL::Test::TAPListener; -package Bar; -use base qw(Foo); - -__PACKAGE__->PassThroughArgs; +my $plan = new IMPL::Test::Plan qw( + Test::Object::Common + Test::Object::List +); -sub CTOR { - print "CTOR Bar\n"; -} - -package main; - -my $obj = new Bar ( Name => 'Tom') ; - -Hello $obj; \ No newline at end of file +$plan->AddListener(new IMPL::Test::TAPListener); +$plan->Prepare(); +$plan->Run();
--- a/impl.kpf Mon Aug 10 17:39:08 2009 +0400 +++ b/impl.kpf Tue Aug 11 17:45:52 2009 +0400 @@ -110,6 +110,13 @@ <preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843"> <boolean id="import_live">1</boolean> <string relative="path" id="perlExtraPaths">Lib</string> +<preference-set id="testPlans"> +<preference-set id="impl.kpf - test plan # 1"> + <string id="command_line"></string> + <string relative="url" id="directory"></string> + <string id="language">Perl - TAP (*.t)</string> +</preference-set> +</preference-set> </preference-set> <preference-set idref="66c7d414-175f-45b6-92fe-dbda51c64843/Lib/IMPL/Object.pm"> <preference-set id="Invocations">