t/001_mouse/007-attributes.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6 use Test::Mouse;
   7
   8 use lib 't/lib';
   9 use MooseCompat;
  10
  11 do {
  12     package Class;
  13     use Mouse;
  14
  15     has 'x' => (
  16         is => 'bare',
  17     );
  18
  19     has 'y' => (
  20         is => 'ro',
  21     );
  22
  23     has 'z' => (
  24         is => 'rw',
  25     );
  26
  27     has 'attr' => (
  28         accessor => 'rw_attr',
  29         reader   => 'read_attr',
  30         writer   => 'write_attr',
  31     );
  32     has 'attr2' => (
  33         is       => 'rw',
  34         accessor => 'rw_attr2',
  35     );
  36 };
  37 with_immutable {
  38     ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
  39     can_ok('Class', 'y', 'z');
  40
  41     has_attribute_ok 'Class', 'x';
  42     has_attribute_ok 'Class', 'y';
  43     has_attribute_ok 'Class', 'z';
  44
  45     my $object = Class->new;
  46
  47     ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
  48     can_ok($object, 'y', 'z');
  49
  50     is($object->y, undef);
  51
  52     throws_ok {
  53         $object->y(10);
  54     } qr/Cannot assign a value to a read-only accessor/;
  55
  56     is($object->y, undef);
  57
  58     is($object->z, undef);
  59     is($object->z(10), 10);
  60     is($object->z, 10);
  61
  62     can_ok($object, qw(rw_attr read_attr write_attr));
  63     $object->write_attr(42);
  64     is $object->rw_attr, 42;
  65     is $object->read_attr, 42;
  66     $object->rw_attr(100);
  67     is $object->rw_attr, 100;
  68     is $object->read_attr, 100;
  69
  70     is $object->write_attr("piyo"), "piyo";
  71     is $object->rw_attr("yopi"),    "yopi";
  72
  73     can_ok $object, qw(rw_attr2);
  74     ok !$object->can('attr2'), "doesn't have attr2";
  75
  76     dies_ok {
  77         Class->rw_attr();
  78     };
  79     dies_ok {
  80         Class->read_attr();
  81     };
  82     dies_ok {
  83         Class->write_attr(42);
  84     };
  85
  86     my @attrs = map { $_->name }
  87         sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
  88     is join(' ', @attrs), 'x y z attr attr2', 'insertion_order';
  89 } qw(Class);
  90 done_testing;