t/001_mouse/028-subclass-attr.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Mouse;
   6 do {
   7     package Class;
   8     use Mouse;
   9
  10     has class => (
  11         is  => 'rw',
  12         isa => 'Bool',
  13     );
  14
  15     package Child;
  16     use Mouse;
  17     extends 'Class';
  18
  19     has child => (
  20         is  => 'rw',
  21         isa => 'Bool',
  22     );
  23
  24     package CA;
  25     use Mouse;
  26     extends qw(Class);
  27     has ca => (is => 'rw');
  28     package CB;
  29     use Mouse;
  30     extends qw(Class);
  31     has cb => (is => 'rw');
  32     package CC;
  33     use Mouse;
  34     extends qw(CB CA);
  35     has cc => (is => 'rw');
  36 };
  37 with_immutable {
  38     my $obj = Child->new(class => 1, child => 1);
  39     ok($obj->child, "local attribute set in constructor");
  40     ok($obj->class, "inherited attribute set in constructor");
  41
  42     is_deeply([sort(Child->meta->get_all_attributes)], [sort(
  43         Child->meta->get_attribute('child'),
  44         Class->meta->get_attribute('class'),
  45     )], "correct get_all_attributes");
  46
  47     is_deeply([sort(CC->meta->get_all_attributes)], [sort(
  48         CC->meta->get_attribute('cc'),
  49         CB->meta->get_attribute('cb'),
  50         CA->meta->get_attribute('ca'),
  51         Class->meta->get_attribute('class'),
  52     )], "correct get_all_attributes");
  53 } 'Class', 'CA', 'CB', 'CC';
  54
  55 do {
  56     package Foo;
  57     use Mouse;
  58
  59     has attr => (
  60         is      => 'ro',
  61         default => 'Foo',
  62     );
  63
  64     package Bar;
  65     use Mouse;
  66     extends 'Foo';
  67
  68     has attr => (
  69         is => 'rw',
  70     );
  71 };
  72
  73 with_immutable {
  74     my $foo = Foo->new;
  75     is($foo->attr, 'Foo', 'subclass does not affect parent attr');
  76
  77     my $bar = Bar->new;
  78     is($bar->attr, undef, 'new attribute does not have the new default');
  79
  80     is(Foo->meta->get_attribute('attr')->default, 'Foo');
  81     is(Foo->meta->get_attribute('attr')->_is_metadata, 'ro');
  82
  83     is(Bar->meta->get_attribute('attr')->default, undef);
  84     is(Bar->meta->get_attribute('attr')->_is_metadata, 'rw');
  85
  86     is_deeply([Foo->meta->get_all_attributes], [
  87         Foo->meta->get_attribute('attr'),
  88     ], "correct get_all_attributes");
  89
  90     is_deeply([Bar->meta->get_all_attributes], [
  91         Bar->meta->get_attribute('attr'),
  92     ], "correct get_all_attributes");
  93 } 'Foo', 'Bar';
  94
  95 done_testing;
  96