t/038_attribute_inherited_slot_specs.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 12;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 =pod
  14
  15 http://www.gwydiondylan.org/books/drm/Instance_Creation_and_Initialization#HEADING43-37
  16
  17 =cut
  18
  19 {
  20     package Foo;
  21     use strict;
  22     use warnings;
  23     use Moose;
  24
  25     has 'bar' => (is => 'ro', isa => 'Str', default => 'Foo::bar');
  26
  27     package Bar;
  28     use strict;
  29     use warnings;
  30     use Moose;
  31
  32     extends 'Foo';
  33
  34     has '+bar' => (default => 'Bar::bar');
  35 }
  36
  37 my $foo = Foo->new;
  38 isa_ok($foo, 'Foo');
  39
  40 is($foo->bar, 'Foo::bar', '... got the right default value');
  41
  42 dies_ok { $foo->bar(10) } '... Foo::bar is a read/only attr';
  43
  44 my $bar = Bar->new;
  45 isa_ok($bar, 'Bar');
  46 isa_ok($bar, 'Foo');
  47
  48 is($bar->bar, 'Bar::bar', '... got the right default value');
  49
  50 dies_ok { $bar->bar(10) } '... Bar::bar is a read/only attr';
  51
  52 # check some meta-stuff
  53
  54 ok(Bar->meta->has_attribute('bar'), '... Bar has a bar attr');
  55 isnt(Foo->meta->get_attribute('bar'),
  56      Bar->meta->get_attribute('bar'),
  57      '... Foo and Bar have different copies of bar');
  58
  59 ok(Bar->meta->get_attribute('bar')->has_type_constraint,
  60    '... Bar::bar inherited the type constraint too');
  61
  62 is(Bar->meta->get_attribute('bar')->type_constraint->name,
  63    'Str', '... Bar::bar inherited the right type constraint too');
  64
  65