t/attributes/attribute_writer_generation.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8
   9 use Scalar::Util 'isweak';
  10
  11
  12 {
  13     package Foo;
  14     use Moose;
  15
  16     eval {
  17         has 'foo' => (
  18             reader => 'get_foo',
  19             writer => 'set_foo',
  20         );
  21     };
  22     ::ok(!$@, '... created the writer method okay');
  23
  24     eval {
  25         has 'foo_required' => (
  26             reader   => 'get_foo_required',
  27             writer   => 'set_foo_required',
  28             required => 1,
  29         );
  30     };
  31     ::ok(!$@, '... created the required writer method okay');
  32
  33     eval {
  34         has 'foo_int' => (
  35             reader => 'get_foo_int',
  36             writer => 'set_foo_int',
  37             isa    => 'Int',
  38         );
  39     };
  40     ::ok(!$@, '... created the writer method with type constraint okay');
  41
  42     eval {
  43         has 'foo_weak' => (
  44             reader   => 'get_foo_weak',
  45             writer   => 'set_foo_weak',
  46             weak_ref => 1
  47         );
  48     };
  49     ::ok(!$@, '... created the writer method with weak_ref okay');
  50 }
  51
  52 {
  53     my $foo = Foo->new(foo_required => 'required');
  54     isa_ok($foo, 'Foo');
  55
  56     # regular writer
  57
  58     can_ok($foo, 'set_foo');
  59     is($foo->get_foo(), undef, '... got an unset value');
  60     is( exception {
  61         $foo->set_foo(100);
  62     }, undef, '... set_foo wrote successfully' );
  63     is($foo->get_foo(), 100, '... got the correct set value');
  64
  65     ok(!isweak($foo->{foo}), '... it is not a weak reference');
  66
  67     # required writer
  68
  69     isnt( exception {
  70         Foo->new;
  71     }, undef, '... cannot create without the required attribute' );
  72
  73     can_ok($foo, 'set_foo_required');
  74     is($foo->get_foo_required(), 'required', '... got an unset value');
  75     is( exception {
  76         $foo->set_foo_required(100);
  77     }, undef, '... set_foo_required wrote successfully' );
  78     is($foo->get_foo_required(), 100, '... got the correct set value');
  79
  80     isnt( exception {
  81         $foo->set_foo_required();
  82     }, undef, '... set_foo_required died successfully with no value' );
  83
  84     is( exception {
  85         $foo->set_foo_required(undef);
  86     }, undef, '... set_foo_required did accept undef' );
  87
  88     ok(!isweak($foo->{foo_required}), '... it is not a weak reference');
  89
  90     # with type constraint
  91
  92     can_ok($foo, 'set_foo_int');
  93     is($foo->get_foo_int(), undef, '... got an unset value');
  94     is( exception {
  95         $foo->set_foo_int(100);
  96     }, undef, '... set_foo_int wrote successfully' );
  97     is($foo->get_foo_int(), 100, '... got the correct set value');
  98
  99     isnt( exception {
 100         $foo->set_foo_int("Foo");
 101     }, undef, '... set_foo_int died successfully' );
 102
 103     ok(!isweak($foo->{foo_int}), '... it is not a weak reference');
 104
 105     # with weak_ref
 106
 107     my $test = [];
 108
 109     can_ok($foo, 'set_foo_weak');
 110     is($foo->get_foo_weak(), undef, '... got an unset value');
 111     is( exception {
 112         $foo->set_foo_weak($test);
 113     }, undef, '... set_foo_weak wrote successfully' );
 114     is($foo->get_foo_weak(), $test, '... got the correct set value');
 115
 116     ok(isweak($foo->{foo_weak}), '... it is a weak reference');
 117 }
 118
 119 done_testing;