t/020_attributes/002_attribute_writer_generation.t

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