Remove the redefine type tests for now, they'll go in a separate file
[gitmo/Mouse.git] / t / 017-default-reference.t
CommitLineData
c3398f5b 1#!/usr/bin/env perl
2use strict;
3use warnings;
c2178409 4use Test::More tests => 9;
eab81545 5use Test::Exception;
c3398f5b 6
7do {
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',
085c18e9 42 default => Test::Builder->new,
c3398f5b 43 );
44 } qr/References are not allowed as default values/;
45};
46
47is(ref(Class->new->code), 'CODE', "default => sub { sub { 1 } } stuffs a coderef");
48is(Class->new->code->(), 1, "default => sub sub strips off the first coderef");
49is_deeply(Class->new->a, [1], "default of sub { reference } works");
50
c2178409 51do {
52 package Class::Two;
53 use Mouse;
17c2c4c1 54 has foo => (is => 'rw', default => sub {
55 die unless $_[0]->isa('Class::Two');
56 shift->default_foo;
57 });
c2178409 58 sub default_foo { 1 };
59};
60
61my $obj2 = Class::Two->new;
62is($obj2->foo, 1, 'default method gets the $_[0] it needs to work');