t/032_attribute_accessor_generation.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 33;
   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 strict;
  18     use warnings;
  19     use Moose;
  20
  21     eval {
  22         has 'foo' => (
  23             accessor => 'foo',
  24         );
  25     };
  26     ::ok(!$@, '... created the accessor method okay');
  27
  28     eval {
  29         has 'lazy_foo' => (
  30             accessor => 'lazy_foo',
  31             lazy     => 1,
  32             default  => sub { 10 }
  33         );
  34     };
  35     ::ok(!$@, '... created the lazy accessor method okay');
  36
  37
  38     eval {
  39         has 'foo_required' => (
  40             accessor => 'foo_required',
  41             required => 1,
  42         );
  43     };
  44     ::ok(!$@, '... created the required accessor method okay');
  45
  46     eval {
  47         has 'foo_int' => (
  48             accessor => 'foo_int',
  49             isa      => 'Int',
  50         );
  51     };
  52     ::ok(!$@, '... created the accessor method with type constraint okay');
  53
  54     eval {
  55         has 'foo_weak' => (
  56             accessor => 'foo_weak',
  57             weak_ref => 1
  58         );
  59     };
  60     ::ok(!$@, '... created the accessor method with weak_ref okay');
  61 }
  62
  63 {
  64     my $foo = Foo->new(foo_required => 'required');
  65     isa_ok($foo, 'Foo');
  66
  67     # regular accessor
  68
  69     can_ok($foo, 'foo');
  70     is($foo->foo(), undef, '... got an unset value');
  71     lives_ok {
  72         $foo->foo(100);
  73     } '... foo wrote successfully';
  74     is($foo->foo(), 100, '... got the correct set value');
  75
  76     ok(!isweak($foo->{foo}), '... it is not a weak reference');
  77
  78     # required writer
  79
  80     dies_ok {
  81         Foo->new;
  82     } '... cannot create without the required attribute';
  83
  84     can_ok($foo, 'foo_required');
  85     is($foo->foo_required(), 'required', '... got an unset value');
  86     lives_ok {
  87         $foo->foo_required(100);
  88     } '... foo_required wrote successfully';
  89     is($foo->foo_required(), 100, '... got the correct set value');
  90
  91     dies_ok {
  92         $foo->foo_required(undef);
  93     } '... foo_required died successfully';
  94
  95     ok(!isweak($foo->{foo_required}), '... it is not a weak reference');
  96
  97     # lazy
  98
  99     ok(!exists($foo->{lazy_foo}), '... no value in lazy_foo slot');
 100
 101     can_ok($foo, 'lazy_foo');
 102     is($foo->lazy_foo(), 10, '... got an deferred value');
 103
 104     # with type constraint
 105
 106     can_ok($foo, 'foo_int');
 107     is($foo->foo_int(), undef, '... got an unset value');
 108     lives_ok {
 109         $foo->foo_int(100);
 110     } '... foo_int wrote successfully';
 111     is($foo->foo_int(), 100, '... got the correct set value');
 112
 113     dies_ok {
 114         $foo->foo_int("Foo");
 115     } '... foo_int died successfully';
 116
 117     ok(!isweak($foo->{foo_int}), '... it is not a weak reference');
 118
 119     # with weak_ref
 120
 121     my $test = [];
 122
 123     can_ok($foo, 'foo_weak');
 124     is($foo->foo_weak(), undef, '... got an unset value');
 125     lives_ok {
 126         $foo->foo_weak($test);
 127     } '... foo_weak wrote successfully';
 128     is($foo->foo_weak(), $test, '... got the correct set value');
 129
 130     ok(isweak($foo->{foo_weak}), '... it is a weak reference');
 131
 132 }
 133
 134
 135