Commit | Line | Data |
af3c1f96 |
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 |
a4154081 |
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'/; |
af3c1f96 |
69 | |
70 | $foo->type_constrained(10); |
71 | $bar->type_constrained(5); |
72 | |
a4154081 |
73 | Child->meta->rebless_instance($foo); |
74 | Child->meta->rebless_instance($bar); |
af3c1f96 |
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 /; |