t/020_attributes/003_attribute_accessor_generation.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 57;
   7 use Test::Exception;
   8
   9 use Scalar::Util 'isweak';
  10
  11
  12
  13 {
  14     package Foo;
  15     use Mouse;
  16
  17     eval {
  18         has 'foo' => (
  19             accessor => 'foo',
  20         );
  21     };
  22     ::ok(!$@, '... created the accessor method okay');
  23
  24     eval {
  25         has 'lazy_foo' => (
  26             accessor => 'lazy_foo',
  27             lazy     => 1,
  28             default  => sub { 10 }
  29         );
  30     };
  31     ::ok(!$@, '... created the lazy accessor method okay');
  32
  33
  34     eval {
  35         has 'foo_required' => (
  36             accessor => 'foo_required',
  37             required => 1,
  38         );
  39     };
  40     ::ok(!$@, '... created the required accessor method okay');
  41
  42     eval {
  43         has 'foo_int' => (
  44             accessor => 'foo_int',
  45             isa      => 'Int',
  46         );
  47     };
  48     ::ok(!$@, '... created the accessor method with type constraint okay');
  49
  50     eval {
  51         has 'foo_weak' => (
  52             accessor => 'foo_weak',
  53             weak_ref => 1
  54         );
  55     };
  56     ::ok(!$@, '... created the accessor method with weak_ref okay');
  57
  58     eval {
  59         has 'foo_deref' => (
  60             accessor => 'foo_deref',
  61             isa => 'ArrayRef',
  62             auto_deref => 1,
  63         );
  64     };
  65     ::ok(!$@, '... created the accessor method with auto_deref okay');
  66
  67     eval {
  68         has 'foo_deref_ro' => (
  69             reader => 'foo_deref_ro',
  70             isa => 'ArrayRef',
  71             auto_deref => 1,
  72         );
  73     };
  74     ::ok(!$@, '... created the reader method with auto_deref okay');
  75
  76     eval {
  77         has 'foo_deref_hash' => (
  78             accessor => 'foo_deref_hash',
  79             isa => 'HashRef',
  80             auto_deref => 1,
  81         );
  82     };
  83     ::ok(!$@, '... created the reader method with auto_deref okay');
  84 }
  85
  86 {
  87     my $foo = Foo->new(foo_required => 'required');
  88     isa_ok($foo, 'Foo');
  89
  90     # regular accessor
  91
  92     can_ok($foo, 'foo');
  93     is($foo->foo(), undef, '... got an unset value');
  94     lives_ok {
  95         $foo->foo(100);
  96     } '... foo wrote successfully';
  97     is($foo->foo(), 100, '... got the correct set value');
  98
  99     ok(!isweak($foo->{foo}), '... it is not a weak reference');
 100
 101     # required writer
 102
 103     dies_ok {
 104         Foo->new;
 105     } '... cannot create without the required attribute';
 106
 107     can_ok($foo, 'foo_required');
 108     is($foo->foo_required(), 'required', '... got an unset value');
 109     lives_ok {
 110         $foo->foo_required(100);
 111     } '... foo_required wrote successfully';
 112     is($foo->foo_required(), 100, '... got the correct set value');
 113
 114     lives_ok {
 115         $foo->foo_required(undef);
 116     } '... foo_required did not die with undef';
 117
 118     is($foo->foo_required, undef, "value is undef");
 119
 120     ok(!isweak($foo->{foo_required}), '... it is not a weak reference');
 121
 122     # lazy
 123
 124     ok(!exists($foo->{lazy_foo}), '... no value in lazy_foo slot');
 125
 126     can_ok($foo, 'lazy_foo');
 127     is($foo->lazy_foo(), 10, '... got an deferred value');
 128
 129     # with type constraint
 130
 131     can_ok($foo, 'foo_int');
 132     is($foo->foo_int(), undef, '... got an unset value');
 133     lives_ok {
 134         $foo->foo_int(100);
 135     } '... foo_int wrote successfully';
 136     is($foo->foo_int(), 100, '... got the correct set value');
 137
 138     dies_ok {
 139         $foo->foo_int("Foo");
 140     } '... foo_int died successfully';
 141
 142     ok(!isweak($foo->{foo_int}), '... it is not a weak reference');
 143
 144     # with weak_ref
 145
 146     my $test = [];
 147
 148     can_ok($foo, 'foo_weak');
 149     is($foo->foo_weak(), undef, '... got an unset value');
 150     lives_ok {
 151         $foo->foo_weak($test);
 152     } '... foo_weak wrote successfully';
 153     is($foo->foo_weak(), $test, '... got the correct set value');
 154
 155     ok(isweak($foo->{foo_weak}), '... it is a weak reference');
 156
 157     can_ok( $foo, 'foo_deref');
 158     is_deeply( [$foo->foo_deref()], [], '... default default value');
 159     my @list;
 160     lives_ok {
 161         @list = $foo->foo_deref();
 162     } "... doesn't deref undef value";
 163     is_deeply( \@list, [], "returns empty list in list context");
 164
 165     lives_ok {
 166         $foo->foo_deref( [ qw/foo bar gorch/ ] );
 167     } '... foo_deref wrote successfully';
 168
 169     is( Scalar::Util::reftype( scalar $foo->foo_deref() ), "ARRAY", "returns an array reference in scalar context" );
 170     is_deeply( scalar($foo->foo_deref()), [ qw/foo bar gorch/ ], "correct array" );
 171
 172     is( scalar( () = $foo->foo_deref() ), 3, "returns list in list context" );
 173     is_deeply( [ $foo->foo_deref() ], [ qw/foo bar gorch/ ], "correct list" );
 174
 175
 176     can_ok( $foo, 'foo_deref' );
 177     is_deeply( [$foo->foo_deref_ro()], [], "... default default value" );
 178
 179     dies_ok {
 180         $foo->foo_deref_ro( [] );
 181     } "... read only";
 182
 183     $foo->{foo_deref_ro} = [qw/la la la/];
 184
 185     is_deeply( scalar($foo->foo_deref_ro()), [qw/la la la/], "scalar context ro" );
 186     is_deeply( [ $foo->foo_deref_ro() ], [qw/la la la/], "list context ro" );
 187
 188     can_ok( $foo, 'foo_deref_hash' );
 189     is_deeply( { $foo->foo_deref_hash() }, {}, "... default default value" );
 190
 191     my %hash;
 192     lives_ok {
 193         %hash = $foo->foo_deref_hash();
 194     } "... doesn't deref undef value";
 195     is_deeply( \%hash, {}, "returns empty list in list context");
 196
 197     lives_ok {
 198         $foo->foo_deref_hash( { foo => 1, bar => 2 } );
 199     } '... foo_deref_hash wrote successfully';
 200
 201     is_deeply( scalar($foo->foo_deref_hash), { foo => 1, bar => 2 }, "scalar context" );
 202
 203     %hash = $foo->foo_deref_hash;
 204     is_deeply( \%hash, { foo => 1, bar => 2 }, "list context");
 205 }
 206
 207
 208