lib/Module/Build/t/add_property.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
   5 use MBTest tests => 29;
   6 #use MBTest 'no_plan';
   7 use DistGen;
   8
   9 BEGIN { use_ok 'Module::Build' or die; }
  10 ensure_blib 'Module::Build';
  11
  12 my $tmp = MBTest->tmpdir;
  13 my $dist = DistGen->new( dir => $tmp );
  14 $dist->regen;
  15 $dist->chdir_in;
  16
  17 ADDPROP: {
  18   package My::Build::Prop;
  19   use base 'Module::Build';
  20   __PACKAGE__->add_property( 'foo' );
  21   __PACKAGE__->add_property( 'bar', 'howdy' );
  22   __PACKAGE__->add_property( 'baz', default => 'howdy' );
  23   __PACKAGE__->add_property( 'code', default => sub { 'yay' } );
  24   __PACKAGE__->add_property(
  25     'check',
  26     default => sub { 'howdy' },
  27     check   => sub {
  28       return 1 if $_ eq 'howdy';
  29       shift->property_error(qq{"$_" is invalid});
  30       return 0;
  31     },
  32   );
  33   __PACKAGE__->add_property(
  34     'hash',
  35     default => { foo => 1 },
  36     check   => sub {
  37       return 1 if !defined $_ or exists $_->{foo};
  38       shift->property_error(qq{hash is invalid});
  39       return 0;
  40     },
  41   );
  42 }
  43
  44 ok my $build = My::Build::Prop->new(
  45   'module_name' => 'Simple',
  46   quiet => 1,
  47 ), 'Create new build object';
  48
  49 is $build->foo, undef, 'Property "foo" should be undef';
  50 ok $build->foo(42), 'Set "foo"';
  51 is $build->foo, 42, 'Now "foo" should have new value';
  52
  53 is $build->bar, 'howdy', 'Property "bar" should be its default';
  54 ok $build->bar('yo'), 'Set "bar"';
  55 is $build->bar, 'yo', 'Now "bar" should have new value';
  56
  57 is $build->check, 'howdy', 'Property "check" should be its default';
  58
  59 eval { $build->check('yo') };
  60 ok my $err = $@, 'Should get an error for an invalid value';
  61 like $err, qr/^ERROR: "yo" is invalid/, 'It should be the correct error';
  62
  63 is $build->code, 'yay', 'Property "code" should have its code value';
  64
  65 is_deeply $build->hash, { foo => 1 }, 'Property "hash" should be default';
  66 is $build->hash('foo'), 1, 'Should be able to get key in hash';
  67 ok $build->hash( bar => 3 ), 'Add a key to the hash prop';
  68 is_deeply $build->hash, { foo => 1, bar => 3 }, 'New key should be in hash';
  69
  70 eval { $build->hash({ bar => 3 }) };
  71 ok $err = $@, 'Should get exception for assigning invalid hash';
  72 like $err, qr/^ERROR: hash is invalid/, 'It should be the correct error';
  73
  74 eval { $build->hash( []) };
  75 ok $err = $@, 'Should get exception for assigning an array for a hash';
  76 like $err, qr/^Unexpected arguments for property 'hash'/,
  77   'It should be the proper error';
  78 is $build->hash(undef), undef, 'Should be able to set hash to undef';
  79
  80 # Check core properties.
  81 is $build->installdirs, 'site', 'Property "installdirs" should be default';
  82 ok $build->installdirs('core'), 'Set "installdirst" to "core"';
  83 is $build->installdirs, 'core', 'Now "installdirs" should be "core"';
  84
  85 eval { $build->installdirs('perl') };
  86 ok $err = $@, 'Should have caught exception setting "installdirs" to "perl"';
  87 like $err, qr/^ERROR: Perhaps you meant installdirs to be "core" rather than "perl"\?/,
  88   'And it should suggest "core" in the error message';
  89
  90 eval { $build->installdirs('foo') };
  91 ok $err = $@, 'Should catch exception for invalid "installdirs" value';
  92 like $err, qr/ERROR: installdirs must be one of "core", "site", or "vendor"/,
  93   'And it should suggest the proper values in the error message';