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">