t/020_attributes/021_method_generation_rules.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 18;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 =pod
  14
  15     is => rw, writer => _foo    # turns into (reader => foo, writer => _foo)
  16     is => ro, writer => _foo    # turns into (reader => foo, writer => _foo) as before
  17     is => rw, accessor => _foo  # turns into (accessor => _foo)
  18     is => ro, accessor => _foo  # error, accesor is rw
  19
  20 =cut
  21
  22 sub make_class {
  23         my ($is, $attr, $class) = @_;
  24
  25         eval "package $class; use Moose; has 'foo' => ( is => '$is', $attr => '_foo' );";
  26
  27         return $@ ? die $@ : $class;
  28 }
  29
  30 my $obj;
  31 my $class;
  32
  33 $class = make_class('rw', 'writer', 'Test::Class::WriterRW');
  34 ok($class, "Can define attr with rw + writer");
  35
  36 $obj = $class->new();
  37
  38 can_ok($obj, qw/foo _foo/);
  39 lives_ok {$obj->_foo(1)} "$class->_foo is writer";
  40 is($obj->foo(), 1, "$class->foo is reader");
  41 dies_ok {$obj->foo(2)} "$class->foo is not writer"; # this should fail
  42 ok(!defined $obj->_foo(), "$class->_foo is not reader");
  43
  44 $class = make_class('ro', 'writer', 'Test::Class::WriterRO');
  45 ok($class, "Can define attr with ro + writer");
  46
  47 $obj = $class->new();
  48
  49 can_ok($obj, qw/foo _foo/);
  50 lives_ok {$obj->_foo(1)} "$class->_foo is writer";
  51 is($obj->foo(), 1, "$class->foo is reader");
  52 dies_ok {$obj->foo(1)} "$class->foo is not writer";
  53 isnt($obj->_foo(), 1, "$class->_foo is not reader");
  54
  55 $class = make_class('rw', 'accessor', 'Test::Class::AccessorRW');
  56 ok($class, "Can define attr with rw + accessor");
  57
  58 $obj = $class->new();
  59
  60 can_ok($obj, qw/_foo/);
  61 lives_ok {$obj->_foo(1)} "$class->_foo is writer";
  62 is($obj->_foo(), 1, "$class->foo is reader");
  63
  64 dies_ok { make_class('ro', 'accessor', "Test::Class::AccessorRO"); } "Cant define attr with ro + accessor";
  65