Commit | Line | Data |
7eb5dc63 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
8d8356bb |
6 | use Test::More tests => 12; |
7eb5dc63 |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('MooseX::Storage'); |
11 | } |
12 | |
b430caa3 |
13 | =pod |
14 | |
15 | This test demonstrates two things: |
16 | |
17 | - cycles will not work in the default engine |
18 | - you can use a special metaclass to tell |
19 | MooseX::Storage to skip an attribute |
20 | |
21 | =cut |
22 | |
7eb5dc63 |
23 | { |
24 | |
25 | package Circular; |
26 | use Moose; |
27 | use MooseX::Storage; |
28 | |
29 | with Storage; |
30 | |
31 | has 'cycle' => (is => 'rw', isa => 'Circular'); |
32 | } |
33 | |
34 | { |
35 | my $circular = Circular->new; |
36 | isa_ok($circular, 'Circular'); |
37 | |
38 | $circular->cycle($circular); |
39 | |
40 | throws_ok { |
41 | $circular->pack; |
42 | } qr/^Basic Engine does not support cycles/, |
43 | '... cannot collapse a cycle with the basic engine'; |
44 | } |
45 | |
46 | { |
47 | my $packed_circular = { __CLASS__ => 'Circular' }; |
48 | $packed_circular->{cycle} = $packed_circular; |
49 | |
50 | throws_ok { |
51 | Circular->unpack($packed_circular); |
52 | } qr/^Basic Engine does not support cycles/, |
53 | '... cannot expand a cycle with the basic engine'; |
54 | } |
55 | |
b430caa3 |
56 | { |
57 | |
58 | package Tree; |
59 | use Moose; |
60 | use MooseX::Storage; |
61 | |
62 | with Storage; |
63 | |
64 | has 'node' => (is => 'rw'); |
65 | |
66 | has 'children' => ( |
67 | is => 'ro', |
68 | isa => 'ArrayRef', |
69 | default => sub {[]} |
70 | ); |
71 | |
72 | has 'parent' => ( |
eebcb6dc |
73 | metaclass => 'DoNotSerialize', |
b430caa3 |
74 | is => 'rw', |
75 | isa => 'Tree', |
76 | ); |
77 | |
78 | sub add_child { |
79 | my ($self, $child) = @_; |
80 | $child->parent($self); |
81 | push @{$self->children} => $child; |
82 | } |
83 | } |
84 | |
85 | { |
86 | my $t = Tree->new(node => 100); |
87 | isa_ok($t, 'Tree'); |
88 | |
89 | is_deeply( |
90 | $t->pack, |
91 | { |
92 | __CLASS__ => 'Tree', |
93 | node => 100, |
94 | children => [], |
95 | }, |
96 | '... got the right packed version'); |
97 | |
98 | my $t2 = Tree->new(node => 200); |
99 | isa_ok($t2, 'Tree'); |
100 | |
101 | $t->add_child($t2); |
102 | |
103 | is_deeply($t->children, [ $t2 ], '... got the right children in $t'); |
104 | |
105 | is($t2->parent, $t, '... created the cycle correctly'); |
106 | isa_ok($t2->parent, 'Tree'); |
107 | |
108 | is_deeply( |
109 | $t->pack, |
110 | { |
111 | __CLASS__ => 'Tree', |
112 | node => 100, |
113 | children => [ |
114 | { |
115 | __CLASS__ => 'Tree', |
116 | node => 200, |
117 | children => [], |
118 | } |
119 | ], |
120 | }, |
121 | '... got the right packed version (with parent attribute skipped in child)'); |
122 | |
123 | is_deeply( |
124 | $t2->pack, |
125 | { |
126 | __CLASS__ => 'Tree', |
127 | node => 200, |
128 | children => [], |
129 | }, |
130 | '... got the right packed version (with parent attribute skipped)'); |
131 | } |
7eb5dc63 |
132 | |
133 | |