t/007-attributes.t

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