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 };
  33 with_immutable {
  34     ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
  35     can_ok('Class', 'y', 'z');
  36
  37     has_attribute_ok 'Class', 'x';
  38     has_attribute_ok 'Class', 'y';
  39     has_attribute_ok 'Class', 'z';
  40
  41     my $object = Class->new;
  42
  43     ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
  44     can_ok($object, 'y', 'z');
  45
  46     is($object->y, undef);
  47
  48     throws_ok {
  49         $object->y(10);
  50     } qr/Cannot assign a value to a read-only accessor/;
  51
  52     is($object->y, undef);
  53
  54     is($object->z, undef);
  55     is($object->z(10), 10);
  56     is($object->z, 10);
  57
  58     can_ok($object, qw(rw_attr read_attr write_attr));
  59     $object->write_attr(42);
  60     is $object->rw_attr, 42;
  61     is $object->read_attr, 42;
  62     $object->rw_attr(100);
  63     is $object->rw_attr, 100;
  64     is $object->read_attr, 100;
  65
  66     is $object->write_attr("piyo"), "piyo";
  67     is $object->rw_attr("yopi"),    "yopi";
  68
  69     dies_ok {
  70         Class->rw_attr();
  71     };
  72     dies_ok {
  73         Class->read_attr();
  74     };
  75     dies_ok {
  76         Class->write_attr(42);
  77     };
  78
  79     my @attrs = map { $_->name }
  80         sort { $a->insertion_order <=> $b->insertion_order } $object->meta->get_all_attributes;
  81     is join(' ', @attrs), 'x y z attr', 'insertion_order';
  82 } qw(Class);
  83 done_testing;