Commit | Line | Data |
af3c1f96 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
01f07d05 |
8 | use Test::Moose qw(with_immutable); |
af3c1f96 |
9 | use Scalar::Util 'blessed'; |
10 | |
7ff56534 |
11 | use Moose::Util::TypeConstraints; |
af3c1f96 |
12 | |
13 | subtype '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 |
56 | my @classes = qw(Parent Child); |
af3c1f96 |
57 | |
01f07d05 |
58 | with_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 | |
89 | done_testing; |