t/020_attributes/009_attribute_inherited_slot_specs.t

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