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