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