t/020_attributes/012_misc_attribute_tests.t

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