t/attributes/method_generation_rules.t

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