Update of /cvsroot/module-build/Module-Build/t
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6066/t
Modified Files:
extend.t
Added Files:
parents.t
Log Message:
David's patch for dynamic addition of properties
--- NEW FILE: parents.t ---
use strict;
use Test;
BEGIN { plan tests => 27 }
use Module::Build;
ok(1);
package Foo;
sub foo;
package MySub1;
use base 'Module::Build';
package MySub2;
use base 'MySub1';
package MySub3;
use base qw(MySub2 Foo);
package MyTest;
use base 'Module::Build';
package MyBulk;
use base qw(MySub2 MyTest);
package main;
ok my @parents = MySub1->mb_parents;
# There will be at least one platform class in between.
ok @parents >= 2;
# They should all inherit from Module::Build::Base;
ok ! grep { !$_->isa('Module::Build::Base') } @parents;
ok $parents[0], 'Module::Build';
ok $parents[-1], 'Module::Build::Base';
ok @parents = MySub2->mb_parents;
ok @parents >= 3;
ok ! grep { !$_->isa('Module::Build::Base') } @parents;
ok $parents[0], 'MySub1';
ok $parents[1], 'Module::Build';
ok $parents[-1], 'Module::Build::Base';
ok @parents = MySub3->mb_parents;
ok @parents >= 4;
ok ! grep { !$_->isa('Module::Build::Base') } @parents;
ok $parents[0], 'MySub2';
ok $parents[1], 'MySub1';
ok $parents[2], 'Module::Build';
ok $parents[-1], 'Module::Build::Base';
ok @parents = MyBulk->mb_parents;
ok @parents >= 5;
ok ! grep { !$_->isa('Module::Build::Base') } @parents;
ok $parents[0], 'MySub2';
ok $parents[1], 'MySub1';
ok $parents[2], 'Module::Build';
ok $parents[-2], 'Module::Build::Base';
ok $parents[-1], 'MyTest';
Index: extend.t
===================================================================
RCS file: /cvsroot/module-build/Module-Build/t/extend.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** extend.t 21 Nov 2004 15:32:33 -0000 1.7
--- extend.t 15 Dec 2004 21:32:48 -0000 1.8
***************
*** 1,6 ****
use strict;
use Test;
! BEGIN { plan tests => 11 }
use Module::Build;
ok 1;
--- 1,8 ----
use strict;
+ # Tests various ways to extend Module::Build, e.g. by subclassing.
+
use Test;
! BEGIN { plan tests => 45 }
use Module::Build;
ok 1;
***************
*** 54,55 ****
--- 56,151 ----
$build->dispatch('realclean');
}
+
+
+ {
+ package MBSub;
+ use Test;
+ use vars qw($VERSION @ISA);
+ @ISA = qw(Module::Build);
+ $VERSION = 0.01;
+
+ # Add a new property.
+ ok(__PACKAGE__->add_property('foo'));
+ # Add a new property with a default value.
+ ok(__PACKAGE__->add_property('bar', 'hey'));
+ # Add a hash property.
+ ok(__PACKAGE__->add_property('hash', {}));
+
+
+ # Catch an exception adding an existing property.
+ eval { __PACKAGE__->add_property('module_name')};
+ ok "$@", qr/Property "module_name" already exists/;
+ }
+
+ {
+ package MBSub2;
+ use Test;
+ use vars qw($VERSION @ISA);
+ @ISA = qw(Module::Build);
+ $VERSION = 0.01;
+
+ # Add a new property with a different default value than MBSub has.
+ ok(__PACKAGE__->add_property('bar', 'yow'));
+ }
+
+
+ chdir($start_dir) or die "Can't chdir back to $start_dir: $!";
+ chdir('t') or die "Can't chdir to t/: $!";
+ {
+ ok my $build = MBSub->new( module_name => 'ModuleBuildOne' );
+ ok $build->isa('Module::Build');
+ ok $build->isa('MBSub');
+ ok $build->valid_property('foo');
+ # Ppbbbblllltttt! Stupid Test::ok doesn't know that a code reference
+ # is a true value. Duh! Turns out it executes it and checks its return
+ # value, instead. D'oh! -David Wheeler
+ ok !!$build->can('module_name');
+
+ # Check foo property.
+ ok !!$build->can('foo');
+ ok ! $build->foo;
+ ok $build->foo(1);
+ ok $build->foo;
+
+ # Check bar property.
+ ok !!$build->can('bar');
+ ok $build->bar, 'hey';
+ ok $build->bar('you');
+ ok $build->bar, 'you';
+
+ # Check hash property.
+ ok $build = MBSub->new(
+ module_name => 'ModuleBuildOne',
+ hash => { foo => 'bar', bin => 'foo'}
+ );
+
+ ok !!$build->can('hash');
+ ok ref $build->hash, 'HASH';
+ ok $build->hash->{foo}, 'bar';
+ ok $build->hash->{bin}, 'foo';
+
+ # Check hash property passed via the command-line.
+ {
+ local @ARGV = (
+ '--hash', 'foo=bar',
+ '--hash', 'bin=foo',
+ );
+ ok $build = MBSub->new(
+ module_name => 'ModuleBuildOne',
+ );
+ }
+
+ ok !!$build->can('hash');
+ ok ref $build->hash, 'HASH';
+ ok $build->hash->{foo}, 'bar';
+ ok $build->hash->{bin}, 'foo';
+
+ # Make sure that a different subclass with the same named property has a
+ # different default.
+ ok $build = MBSub2->new( module_name => 'ModuleBuildOne' );
+ ok $build->isa('Module::Build');
+ ok $build->isa('MBSub2');
+ ok $build->valid_property('bar');
+ ok !!$build->can('bar');
+ ok $build->bar, 'yow';
+ }
|
