t/038_attribute_inherited_slot_specs.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 57;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 {
  14     package Foo;
  15     use strict;
  16     use warnings;
  17     use Moose;
  18     use Moose::Util::TypeConstraints;
  19
  20     subtype 'FooStr'
  21         => as 'Str'
  22         => where { /Foo/ };
  23
  24     coerce 'FooStr'
  25         => from ArrayRef
  26             => via { 'FooArrayRef' };
  27
  28     has 'bar' => (is => 'ro', isa => 'Str', default => 'Foo::bar');
  29     has 'baz' => (is => 'rw', isa => 'Ref');
  30     has 'foo' => (is => 'rw', isa => 'FooStr');
  31
  32     has 'gorch' => (is => 'ro');
  33
  34     # this one will work here ....
  35     has 'fail' => (isa => 'CodeRef');
  36     has 'other_fail';
  37
  38     package Bar;
  39     use strict;
  40     use warnings;
  41     use Moose;
  42
  43     extends 'Foo';
  44
  45     has '+bar' => (default => 'Bar::bar');
  46     has '+baz' => (isa     => 'ArrayRef');
  47
  48     has '+foo'   => (coerce   => 1);
  49     has '+gorch' => (required => 1);
  50
  51     # this one will *not* work here ....
  52     ::dies_ok {
  53         has '+fail' => (isa => 'Ref');
  54     } '... cannot create an attribute with an improper subtype relation';
  55     ::dies_ok {
  56         has '+other_fail' => (trigger => sub {});
  57     } '... cannot create an attribute with an illegal option';
  58     ::dies_ok {
  59         has '+other_fail' => (weak_ref => 1);
  60     } '... cannot create an attribute with an illegal option';
  61     ::dies_ok {
  62         has '+other_fail' => (lazy => 1);
  63     } '... cannot create an attribute with an illegal option';
  64
  65 }
  66
  67 my $foo = Foo->new;
  68 isa_ok($foo, 'Foo');
  69
  70 is($foo->foo, undef, '... got the right undef default value');
  71 lives_ok { $foo->foo('FooString') } '... assigned foo correctly';
  72 is($foo->foo, 'FooString', '... got the right value for foo');
  73
  74 dies_ok { $foo->foo([]) } '... foo is not coercing (as expected)';
  75
  76 is($foo->bar, 'Foo::bar', '... got the right default value');
  77 dies_ok { $foo->bar(10) } '... Foo::bar is a read/only attr';
  78
  79 is($foo->baz, undef, '... got the right undef default value');
  80
  81 {
  82     my $hash_ref = {};
  83     lives_ok { $foo->baz($hash_ref) } '... Foo::baz accepts hash refs';
  84     is($foo->baz, $hash_ref, '... got the right value assigned to baz');
  85
  86     my $array_ref = [];
  87     lives_ok { $foo->baz($array_ref) } '... Foo::baz accepts an array ref';
  88     is($foo->baz, $array_ref, '... got the right value assigned to baz');
  89
  90     my $scalar_ref = \(my $var);
  91     lives_ok { $foo->baz($scalar_ref) } '... Foo::baz accepts scalar ref';
  92     is($foo->baz, $scalar_ref, '... got the right value assigned to baz');
  93
  94     my $code_ref = sub { 1 };
  95     lives_ok { $foo->baz($code_ref) } '... Foo::baz accepts a code ref';
  96     is($foo->baz, $code_ref, '... got the right value assigned to baz');
  97 }
  98
  99 dies_ok {
 100     Bar->new;
 101 } '... cannot create Bar without required gorch param';
 102
 103 my $bar = Bar->new(gorch => 'Bar::gorch');
 104 isa_ok($bar, 'Bar');
 105 isa_ok($bar, 'Foo');
 106
 107 is($bar->foo, undef, '... got the right undef default value');
 108 lives_ok { $bar->foo('FooString') } '... assigned foo correctly';
 109 is($bar->foo, 'FooString', '... got the right value for foo');
 110 lives_ok { $bar->foo([]) } '... assigned foo correctly';
 111 is($bar->foo, 'FooArrayRef', '... got the right value for foo');
 112
 113 is($bar->gorch, 'Bar::gorch', '... got the right default value');
 114
 115 is($bar->bar, 'Bar::bar', '... got the right default value');
 116 dies_ok { $bar->bar(10) } '... Bar::bar is a read/only attr';
 117
 118 is($bar->baz, undef, '... got the right undef default value');
 119
 120 {
 121     my $hash_ref = {};
 122     dies_ok { $bar->baz($hash_ref) } '... Bar::baz does not accept hash refs';
 123
 124     my $array_ref = [];
 125     lives_ok { $bar->baz($array_ref) } '... Bar::baz can accept an array ref';
 126     is($bar->baz, $array_ref, '... got the right value assigned to baz');
 127
 128     my $scalar_ref = \(my $var);
 129     dies_ok { $bar->baz($scalar_ref) } '... Bar::baz does not accept a scalar ref';
 130
 131     my $code_ref = sub { 1 };
 132     dies_ok { $bar->baz($code_ref) } '... Bar::baz does not accept a code ref';
 133 }
 134
 135 # check some meta-stuff
 136
 137 ok(Bar->meta->has_attribute('foo'), '... Bar has a foo attr');
 138 ok(Bar->meta->has_attribute('bar'), '... Bar has a bar attr');
 139 ok(Bar->meta->has_attribute('baz'), '... Bar has a baz attr');
 140 ok(Bar->meta->has_attribute('gorch'), '... Bar has a gorch attr');
 141 ok(!Bar->meta->has_attribute('fail'), '... Bar does not have a fail attr');
 142 ok(!Bar->meta->has_attribute('other_fail'), '... Bar does not have a fail attr');
 143
 144 isnt(Foo->meta->get_attribute('foo'),
 145      Bar->meta->get_attribute('foo'),
 146      '... Foo and Bar have different copies of foo');
 147 isnt(Foo->meta->get_attribute('bar'),
 148      Bar->meta->get_attribute('bar'),
 149      '... Foo and Bar have different copies of bar');
 150 isnt(Foo->meta->get_attribute('baz'),
 151      Bar->meta->get_attribute('baz'),
 152      '... Foo and Bar have different copies of baz');
 153 isnt(Foo->meta->get_attribute('gorch'),
 154      Bar->meta->get_attribute('gorch'),
 155      '... Foo and Bar have different copies of gorch');
 156
 157 ok(Bar->meta->get_attribute('bar')->has_type_constraint,
 158    '... Bar::bar inherited the type constraint too');
 159 ok(Bar->meta->get_attribute('baz')->has_type_constraint,
 160   '... Bar::baz inherited the type constraint too');
 161
 162 is(Bar->meta->get_attribute('bar')->type_constraint->name,
 163    'Str', '... Bar::bar inherited the right type constraint too');
 164
 165 is(Foo->meta->get_attribute('baz')->type_constraint->name,
 166   'Ref', '... Foo::baz inherited the right type constraint too');
 167 is(Bar->meta->get_attribute('baz')->type_constraint->name,
 168    'ArrayRef', '... Bar::baz inherited the right type constraint too');
 169
 170 ok(!Foo->meta->get_attribute('gorch')->is_required,
 171   '... Foo::gorch is not a required attr');
 172 ok(Bar->meta->get_attribute('gorch')->is_required,
 173    '... Bar::gorch is a required attr');
 174
 175 ok(!Foo->meta->get_attribute('foo')->should_coerce,
 176   '... Foo::foo should not coerce');
 177 ok(Bar->meta->get_attribute('foo')->should_coerce,
 178    '... Bar::foo should coerce');
 179
 180