t/001_mouse/007-attributes.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 21;
   5 use Test::Exception;
   6
   7 use lib 't/lib';
   8 use Test::Mouse;
   9
  10 do {
  11     package Class;
  12     use Mouse;
  13
  14     has 'x' => (
  15         is => 'bare',
  16     );
  17
  18     has 'y' => (
  19         is => 'ro',
  20     );
  21
  22     has 'z' => (
  23         is => 'rw',
  24     );
  25
  26     has 'attr' => (
  27         accessor => 'rw_attr',
  28         reader   => 'read_attr',
  29         writer   => 'write_attr',
  30     );
  31 };
  32
  33 ok(!Class->can('x'), "No accessor is injected if 'is' has no value");
  34 can_ok('Class', 'y', 'z');
  35
  36 has_attribute_ok 'Class', 'x';
  37 has_attribute_ok 'Class', 'y';
  38 has_attribute_ok 'Class', 'z';
  39
  40 my $object = Class->new;
  41
  42 ok(!$object->can('x'), "No accessor is injected if 'is' has no value");
  43 can_ok($object, 'y', 'z');
  44
  45 is($object->y, undef);
  46
  47 throws_ok {
  48     $object->y(10);
  49 } qr/Cannot assign a value to a read-only accessor/;
  50
  51 is($object->y, undef);
  52
  53 is($object->z, undef);
  54 is($object->z(10), 10);
  55 is($object->z, 10);
  56
  57 can_ok($object, qw(rw_attr read_attr write_attr));
  58 $object->write_attr(42);
  59 is $object->rw_attr, 42;
  60 is $object->read_attr, 42;
  61 $object->rw_attr(100);
  62 is $object->rw_attr, 100;
  63 is $object->read_attr, 100;
  64
  65 dies_ok {
  66     Class->rw_attr();
  67 };
  68 dies_ok {
  69     Class->read_attr();
  70 };
  71 dies_ok {
  72     Class->write_attr(42);
  73 };