4 use Test::More tests => 18;
9 use_ok('MooseX::Storage');
14 This test demonstrates two things:
16 - cycles will not work in the default engine
17 - you can use a special metaclass to tell
18 MooseX::Storage to skip an attribute
30 has 'cycle' => (is => 'rw', isa => 'Circular');
34 my $circular = Circular->new;
35 isa_ok($circular, 'Circular');
37 $circular->cycle($circular);
41 }, qr/^Basic Engine does not support cycles/,
42 '... cannot collapse a cycle with the basic engine');
46 my $packed_circular = { __CLASS__ => 'Circular' };
47 $packed_circular->{cycle} = $packed_circular;
50 Circular->unpack($packed_circular);
51 }, qr/^Basic Engine does not support cycles/,
52 '... cannot expand a cycle with the basic engine');
63 has 'node' => (is => 'rw');
72 metaclass => 'DoNotSerialize',
78 my ($self, $child) = @_;
79 $child->parent($self);
80 push @{$self->children} => $child;
85 my $t = Tree->new(node => 100);
95 '... got the right packed version');
97 my $t2 = Tree->new(node => 200);
102 cmp_deeply($t->children, [ $t2 ], '... got the right children in $t');
104 is($t2->parent, $t, '... created the cycle correctly');
105 isa_ok($t2->parent, 'Tree');
120 '... got the right packed version (with parent attribute skipped in child)');
129 '... got the right packed version (with parent attribute skipped)');
132 ### this fails with cycle detection on
138 has 'x' => ( is => 'rw', isa => 'HashRef' );
139 has 'y' => ( is => 'rw', isa => 'HashRef' );
144 my $double = Double->new( 'x' => $ref, 'y' => $ref );
146 ### currently, the cycle checker's too naive to figure out this is not
147 ### a problem, pass an empty hashref to the 2nd test to make sure it
150 local $TODO = "Cycle check is too naive";
151 my $pack = eval { $double->pack; };
152 ok( $pack, "Object with 2 references packed" );
153 ok( Double->unpack( $pack || {} ),
154 " And unpacked again" );
157 my $pack = $double->pack( engine_traits => [qw/DisableCycleDetection/] );
158 ok( $pack, " Object packs when cycle check is disabled");
159 ok( Double->unpack( $pack ),
160 " And unpacked again" );
164 ### the same as above, but now done with a trait
165 ### this fails with cycle detection on
166 { package DoubleNoCycle;
169 with Storage( traits => ['DisableCycleDetection'] );
171 has 'x' => ( is => 'rw', isa => 'HashRef' );
172 has 'y' => ( is => 'rw', isa => 'HashRef' );
177 my $double = DoubleNoCycle->new( 'x' => $ref, 'y' => $ref );
178 my $pack = $double->pack;
179 ok( $pack, "Object packs with DisableCycleDetection trait");
180 ok( DoubleNoCycle->unpack( $pack ),