Commit | Line | Data |
e1bb45ff |
1 | use strict; |
2 | use warnings; |
3 | |
8d8356bb |
4 | use Test::More tests => 11; |
619ab942 |
5 | use Test::Deep; |
e1bb45ff |
6 | |
7 | BEGIN { |
8 | use_ok('MooseX::Storage'); |
9 | } |
10 | |
95f31c36 |
11 | =pod |
12 | |
c2dae5d8 |
13 | This extends the 001_basic test to |
14 | show that subtypes will DWIM in most |
95f31c36 |
15 | cases. |
16 | |
17 | =cut |
18 | |
e1bb45ff |
19 | { |
20 | |
21 | package Foo; |
22 | use Moose; |
23 | use Moose::Util::TypeConstraints; |
24 | use MooseX::Storage; |
25 | |
26 | use Scalar::Util 'looks_like_number'; |
27 | |
c2dae5d8 |
28 | with Storage; |
29 | |
30 | subtype 'Natural' |
e1bb45ff |
31 | => as 'Int' |
32 | => where { $_ > 0 }; |
c2dae5d8 |
33 | |
34 | subtype 'HalfNum' |
e1bb45ff |
35 | => as 'Num' |
c2dae5d8 |
36 | => where { "$_" =~ /\.5$/ }; |
37 | |
e1bb45ff |
38 | subtype 'FooString' |
39 | => as 'Str' |
40 | => where { lc($_) eq 'foo' }; |
c2dae5d8 |
41 | |
42 | subtype 'IntArray' |
e1bb45ff |
43 | => as 'ArrayRef' |
44 | => where { scalar grep { looks_like_number($_) } @{$_} }; |
45 | |
c2dae5d8 |
46 | subtype 'UndefHash' |
e1bb45ff |
47 | => as 'HashRef' |
48 | => where { scalar grep { !defined($_) } values %{$_} }; |
49 | |
50 | has 'number' => ( is => 'ro', isa => 'Natural' ); |
51 | has 'string' => ( is => 'ro', isa => 'FooString' ); |
52 | has 'float' => ( is => 'ro', isa => 'HalfNum' ); |
53 | has 'array' => ( is => 'ro', isa => 'IntArray' ); |
54 | has 'hash' => ( is => 'ro', isa => 'UndefHash' ); |
55 | has 'object' => ( is => 'ro', isa => 'Foo' ); |
56 | } |
57 | |
58 | { |
59 | my $foo = Foo->new( |
60 | number => 10, |
61 | string => 'foo', |
62 | float => 10.5, |
63 | array => [ 1 .. 10 ], |
64 | hash => { map { $_ => undef } ( 1 .. 10 ) }, |
65 | object => Foo->new( number => 2 ), |
66 | ); |
67 | isa_ok( $foo, 'Foo' ); |
c2dae5d8 |
68 | |
619ab942 |
69 | cmp_deeply( |
e1bb45ff |
70 | $foo->pack, |
71 | { |
ba5bba75 |
72 | __CLASS__ => 'Foo', |
e1bb45ff |
73 | number => 10, |
74 | string => 'foo', |
75 | float => 10.5, |
76 | array => [ 1 .. 10 ], |
77 | hash => { map { $_ => undef } ( 1 .. 10 ) }, |
c2dae5d8 |
78 | object => { |
79 | __CLASS__ => 'Foo', |
80 | number => 2 |
81 | }, |
e1bb45ff |
82 | }, |
83 | '... got the right frozen class' |
84 | ); |
85 | } |
86 | |
87 | { |
88 | my $foo = Foo->unpack( |
89 | { |
ba5bba75 |
90 | __CLASS__ => 'Foo', |
e1bb45ff |
91 | number => 10, |
92 | string => 'foo', |
93 | float => 10.5, |
94 | array => [ 1 .. 10 ], |
95 | hash => { map { $_ => undef } ( 1 .. 10 ) }, |
c2dae5d8 |
96 | object => { |
97 | __CLASS__ => 'Foo', |
98 | number => 2 |
99 | }, |
100 | } |
e1bb45ff |
101 | ); |
102 | isa_ok( $foo, 'Foo' ); |
103 | |
104 | is( $foo->number, 10, '... got the right number' ); |
105 | is( $foo->string, 'foo', '... got the right string' ); |
106 | is( $foo->float, 10.5, '... got the right float' ); |
619ab942 |
107 | cmp_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' ); |
108 | cmp_deeply( |
e1bb45ff |
109 | $foo->hash, |
110 | { map { $_ => undef } ( 1 .. 10 ) }, |
111 | '... got the right hash' |
112 | ); |
113 | |
114 | isa_ok( $foo->object, 'Foo' ); |
115 | is( $foo->object->number, 2, |
116 | '... got the right number (in the embedded object)' ); |
117 | } |