t/028-subclass-attr.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 3;
   5
   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
  25 my $obj = Child->new(class => 1, child => 1);
  26 ok($obj->child, "local attribute set in constructor");
  27 ok($obj->class, "inherited attribute set in constructor");
  28
  29 is_deeply([Child->meta->compute_all_applicable_attributes], [
  30     Child->meta->get_attribute('child'),
  31     Class->meta->get_attribute('class'),
  32 ], "correct compute_all_applicable_attributes");
  33