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