Remove the redefine type tests for now, they'll go in a separate file
[gitmo/Mouse.git] / t / 017-default-reference.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 9;
5 use Test::Exception;
6
7 do {
8     package Class;
9     use Mouse;
10
11     ::lives_ok {
12         has a => (
13             is => 'rw',
14             default => sub { [1] },
15         );
16     };
17
18     ::lives_ok {
19         has code => (
20             is => 'rw',
21             default => sub { sub { 1 } },
22         );
23     };
24
25     ::throws_ok {
26         has b => (
27             is => 'rw',
28             default => [],
29         );
30     } qr/References are not allowed as default values/;
31
32     ::throws_ok {
33         has c => (
34             is => 'rw',
35             default => {},
36         );
37     } qr/References are not allowed as default values/;
38
39     ::throws_ok {
40         has d => (
41             is => 'rw',
42             default => Test::Builder->new,
43         );
44     } qr/References are not allowed as default values/;
45 };
46
47 is(ref(Class->new->code), 'CODE', "default => sub { sub { 1 } } stuffs a coderef");
48 is(Class->new->code->(), 1, "default => sub sub strips off the first coderef");
49 is_deeply(Class->new->a, [1], "default of sub { reference } works");
50
51 do {
52   package Class::Two;
53   use Mouse;
54   has foo => (is => 'rw', default => sub {
55     die unless $_[0]->isa('Class::Two');
56     shift->default_foo;
57   });
58   sub default_foo { 1 };
59 };
60
61 my $obj2 = Class::Two->new;
62 is($obj2->foo, 1, 'default method gets the $_[0] it needs to work');