6 use Test::More tests => 18;
11 use_ok('MooseX::Storage');
16 This test demonstrates two things:
18 - cycles will not work in the default engine
19 - you can use a special metaclass to tell
20 MooseX::Storage to skip an attribute
32 has 'cycle' => (is => 'rw', isa => 'Circular');
36 my $circular = Circular->new;
37 isa_ok($circular, 'Circular');
39 $circular->cycle($circular);
43 }, qr/^Basic Engine does not support cycles/,
44 '... cannot collapse a cycle with the basic engine');
48 my $packed_circular = { __CLASS__ => 'Circular' };
49 $packed_circular->{cycle} = $packed_circular;
52 Circular->unpack($packed_circular);
53 }, qr/^Basic Engine does not support cycles/,
54 '... cannot expand a cycle with the basic engine');
65 has 'node' => (is => 'rw');
74 metaclass => 'DoNotSerialize',
80 my ($self, $child) = @_;
81 $child->parent($self);
82 push @{$self->children} => $child;
87 my $t = Tree->new(node => 100);
97 '... got the right packed version');
99 my $t2 = Tree->new(node => 200);
104 cmp_deeply($t->children, [ $t2 ], '... got the right children in $t');
106 is($t2->parent, $t, '... created the cycle correctly');
107 isa_ok($t2->parent, 'Tree');
122 '... got the right packed version (with parent attribute skipped in child)');
131 '... got the right packed version (with parent attribute skipped)');
134 ### this fails with cycle detection on
140 has 'x' => ( is => 'rw', isa => 'HashRef' );
141 has 'y' => ( is => 'rw', isa => 'HashRef' );
146 my $double = Double->new( 'x' => $ref, 'y' => $ref );
148 ### currently, the cycle checker's too naive to figure out this is not
149 ### a problem, pass an empty hashref to the 2nd test to make sure it
152 local $TODO = "Cycle check is too naive";
153 my $pack = eval { $double->pack; };
154 ok( $pack, "Object with 2 references packed" );
155 ok( Double->unpack( $pack || {} ),
156 " And unpacked again" );
159 my $pack = $double->pack( engine_traits => [qw/DisableCycleDetection/] );
160 ok( $pack, " Object packs when cycle check is disabled");
161 ok( Double->unpack( $pack ),
162 " And unpacked again" );
166 ### the same as above, but now done with a trait
167 ### this fails with cycle detection on
168 { package DoubleNoCycle;
171 with Storage( traits => ['DisableCycleDetection'] );
173 has 'x' => ( is => 'rw', isa => 'HashRef' );
174 has 'y' => ( is => 'rw', isa => 'HashRef' );
179 my $double = DoubleNoCycle->new( 'x' => $ref, 'y' => $ref );
180 my $pack = $double->pack;
181 ok( $pack, "Object packs with DisableCycleDetection trait");
182 ok( DoubleNoCycle->unpack( $pack ),