[Module-build-checkins] Module-Build/t parents.t,NONE,1.1 extend.t,1.7,1.8

[Ken W. <kwi...@us...>]

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';
+ }