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