t/020_attributes/failing/012_misc_attribute_tests.t

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