Fix for the slightly changed rebless_instance interface
[gitmo/Moose.git] / t / 010_basics / 012_rebless.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 13;
7 use Test::Exception;
8 use Scalar::Util 'blessed';
9
10 BEGIN {
11     use_ok('Moose');
12     use_ok("Moose::Util::TypeConstraints");
13 }
14
15 subtype 'Positive'
16      => as 'Num'
17      => where { $_ > 0 };
18
19 {
20     package Parent;
21     use Moose;
22
23     has name => (
24         is       => 'rw',
25         isa      => 'Str',
26     );
27
28     has lazy_classname => (
29         is      => 'ro',
30         lazy    => 1,
31         default => sub { "Parent" },
32     );
33
34     has type_constrained => (
35         is      => 'rw',
36         isa     => 'Num',
37         default => 5.5,
38     );
39
40     package Child;
41     use Moose;
42     extends 'Parent';
43
44     has '+name' => (
45         default => 'Junior',
46     );
47
48     has '+lazy_classname' => (
49         default => sub { "Child" },
50     );
51
52     has '+type_constrained' => (
53         isa     => 'Int',
54         default => 100,
55     );
56 }
57
58 my $foo = Parent->new;
59 my $bar = Parent->new;
60
61 is(blessed($foo), 'Parent', 'Parent->new gives a Parent object');
62 is($foo->name, undef, 'No name yet');
63 is($foo->lazy_classname, 'Parent', "lazy attribute initialized");
64 lives_ok { $foo->type_constrained(10.5) } "Num type constraint for now..";
65
66 # try to rebless, except it will fail due to Child's stricter type constraint
67 throws_ok { Child->meta->rebless_instance($foo) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '10\.5'/;
68 throws_ok { Child->meta->rebless_instance($bar) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with '5\.5'/;
69
70 $foo->type_constrained(10);
71 $bar->type_constrained(5);
72
73 Child->meta->rebless_instance($foo);
74 Child->meta->rebless_instance($bar);
75
76 is(blessed($foo), 'Child', 'successfully reblessed into Child');
77 is($foo->name, 'Junior', "Child->name's default came through");
78
79 is($foo->lazy_classname, 'Parent', "lazy attribute was already initialized");
80 is($bar->lazy_classname, 'Child', "lazy attribute just now initialized");
81
82 throws_ok { $foo->type_constrained(10.5) } qr/^Attribute \(type_constrained\) does not pass the type constraint \(Int\) with 10\.5 /;