t/020_attributes/012_misc_attribute_tests.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 42;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 {
  14     {
  15         package Test::Attribute::Inline::Documentation;
  16         use Moose;
  17
  18         has 'foo' => (
  19             documentation => q{
  20                 The 'foo' attribute is my favorite
  21                 attribute in the whole wide world.
  22             }
  23         );
  24     }
  25
  26     my $foo_attr = Test::Attribute::Inline::Documentation->meta->get_attribute('foo');
  27
  28     ok($foo_attr->has_documentation, '... the foo has docs');
  29     is($foo_attr->documentation,
  30             q{
  31                 The 'foo' attribute is my favorite
  32                 attribute in the whole wide world.
  33             },
  34     '... got the foo docs');
  35 }
  36
  37 {
  38     {
  39         package Test::For::Lazy::TypeConstraint;
  40         use Moose;
  41         use Moose::Util::TypeConstraints;
  42
  43         has 'bad_lazy_attr' => (
  44             is => 'rw',
  45             isa => 'ArrayRef',
  46             lazy => 1,
  47             default => sub { "test" },
  48         );
  49
  50         has 'good_lazy_attr' => (
  51             is => 'rw',
  52             isa => 'ArrayRef',
  53             lazy => 1,
  54             default => sub { [] },
  55         );
  56
  57     }
  58
  59     my $test = Test::For::Lazy::TypeConstraint->new;
  60     isa_ok($test, 'Test::For::Lazy::TypeConstraint');
  61
  62     dies_ok {
  63         $test->bad_lazy_attr;
  64     } '... this does not work';
  65
  66     lives_ok {
  67         $test->good_lazy_attr;
  68     } '... this does not work';
  69 }
  70
  71 {
  72     {
  73         package Test::Arrayref::Attributes;
  74         use Moose;
  75
  76         has [qw(foo bar baz)] => (
  77             is => 'rw',
  78         );
  79
  80     }
  81
  82     my $test = Test::Arrayref::Attributes->new;
  83     isa_ok($test, 'Test::Arrayref::Attributes');
  84     can_ok($test, qw(foo bar baz));
  85
  86 }
  87
  88 {
  89     {
  90         package Test::UndefDefault::Attributes;
  91         use Moose;
  92
  93         has 'foo' => (
  94             is      => 'ro',
  95             isa     => 'Str',
  96             default => sub { return }
  97         );
  98
  99     }
 100
 101     dies_ok {
 102         Test::UndefDefault::Attributes->new;
 103     } '... default must return a value which passes the type constraint';
 104
 105 }
 106
 107 {
 108     {
 109         package OverloadedStr;
 110         use Moose;
 111         use overload '""' => sub { 'this is *not* a string' };
 112
 113         has 'a_str' => ( isa => 'Str' , is => 'rw' );
 114     }
 115
 116     my $moose_obj = OverloadedStr->new;
 117
 118     is($moose_obj->a_str( 'foobar' ), 'foobar', 'setter took string');
 119     ok($moose_obj, 'this is a *not* a string');
 120
 121     throws_ok {
 122         $moose_obj->a_str( $moose_obj )
 123     } qr/Attribute \(a_str\) does not pass the type constraint because\: Validation failed for 'Str' failed with value OverloadedStr=HASH\(0x.+?\)/,
 124     '... dies without overloading the string';
 125
 126 }
 127
 128 {
 129     {
 130         package OverloadBreaker;
 131         use Moose;
 132
 133         has 'a_num' => ( isa => 'Int' , is => 'rw', default => 7.5 );
 134     }
 135
 136     throws_ok {
 137         OverloadBreaker->new;
 138     } qr/Attribute \(a_num\) does not pass the type constraint because\: Validation failed for 'Int' failed with value 7\.5/,
 139     '... this doesnt trip overload to break anymore ';
 140
 141     lives_ok {
 142         OverloadBreaker->new(a_num => 5);
 143     } '... this works fine though';
 144
 145 }
 146
 147 {
 148     {
 149       package Test::Builder::Attribute;
 150         use Moose;
 151
 152         has 'foo'  => ( required => 1, builder => 'build_foo', is => 'ro');
 153         sub build_foo { return "works" };
 154     }
 155
 156     my $meta = Test::Builder::Attribute->meta;
 157     my $foo_attr  = $meta->get_attribute("foo");
 158
 159     ok($foo_attr->is_required, "foo is required");
 160     ok($foo_attr->has_builder, "foo has builder");
 161     is($foo_attr->builder, "build_foo",  ".. and it's named build_foo");
 162
 163     my $instance = Test::Builder::Attribute->new;
 164     is($instance->foo, 'works', "foo builder works");
 165 }
 166
 167 {
 168     {
 169         package Test::Builder::Attribute::Broken;
 170         use Moose;
 171
 172         has 'foo'  => ( required => 1, builder => 'build_foo', is => 'ro');
 173     }
 174
 175     dies_ok {
 176         Test::Builder::Attribute::Broken->new;
 177     } '... no builder, wtf';
 178 }
 179
 180
 181 {
 182     {
 183       package Test::LazyBuild::Attribute;
 184         use Moose;
 185
 186         has 'foo'  => ( lazy_build => 1, is => 'ro');
 187         has '_foo' => ( lazy_build => 1, is => 'ro');
 188         has 'fool' => ( lazy_build => 1, is => 'ro');
 189         sub _build_foo { return "works" };
 190         sub _build__foo { return "works too" };
 191     }
 192
 193     my $meta = Test::LazyBuild::Attribute->meta;
 194     my $foo_attr  = $meta->get_attribute("foo");
 195     my $_foo_attr = $meta->get_attribute("_foo");
 196
 197     ok($foo_attr->is_lazy, "foo is lazy");
 198     ok($foo_attr->is_required, "foo is required");
 199     ok($foo_attr->is_lazy_build, "foo is lazy_build");
 200
 201     ok($foo_attr->has_clearer, "foo has clearer");
 202     is($foo_attr->clearer, "clear_foo",  ".. and it's named clear_foo");
 203
 204     ok($foo_attr->has_builder, "foo has builder");
 205     is($foo_attr->builder, "_build_foo",  ".. and it's named build_foo");
 206
 207     ok($foo_attr->has_predicate, "foo has predicate");
 208     is($foo_attr->predicate, "has_foo",  ".. and it's named has_foo");
 209
 210     ok($_foo_attr->is_lazy, "_foo is lazy");
 211     ok($_foo_attr->is_required, "_foo is required");
 212     ok($_foo_attr->is_lazy_build, "_foo is lazy_build");
 213
 214     ok($_foo_attr->has_clearer, "_foo has clearer");
 215     is($_foo_attr->clearer, "_clear_foo",  ".. and it's named _clear_foo");
 216
 217     ok($_foo_attr->has_builder, "_foo has builder");
 218     is($_foo_attr->builder, "_build__foo",  ".. and it's named _build_foo");
 219
 220     ok($_foo_attr->has_predicate, "_foo has predicate");
 221     is($_foo_attr->predicate, "_has_foo",  ".. and it's named _has_foo");
 222
 223     my $instance = Test::LazyBuild::Attribute->new;
 224     ok(!$instance->has_foo, "noo foo value yet");
 225     ok(!$instance->_has_foo, "noo _foo value yet");
 226     is($instance->foo, 'works', "foo builder works");
 227     is($instance->_foo, 'works too', "foo builder works too");
 228     throws_ok { $instance->fool }
 229         qr/Test::LazyBuild::Attribute does not support builder method \'_build_fool\' for attribute \'fool\'/,
 230             "Correct error when a builder method is not present";
 231
 232 }
 233