#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 12;
use Test::Exception;
BEGIN {
use_ok('MooseX::Storage');
}
=pod
This test demonstrates two things:
- cycles will not work in the default engine
- you can use a special metaclass to tell
MooseX::Storage to skip an attribute
=cut
{
package Circular;
use Moose;
use MooseX::Storage;
with Storage;
has 'cycle' => (is => 'rw', isa => 'Circular');
}
{
my $circular = Circular->new;
isa_ok($circular, 'Circular');
$circular->cycle($circular);
throws_ok {
$circular->pack;
} qr/^Basic Engine does not support cycles/,
'... cannot collapse a cycle with the basic engine';
}
{
my $packed_circular = { __CLASS__ => 'Circular' };
$packed_circular->{cycle} = $packed_circular;
throws_ok {
Circular->unpack($packed_circular);
} qr/^Basic Engine does not support cycles/,
'... cannot expand a cycle with the basic engine';
}
{
package Tree;
use Moose;
use MooseX::Storage;
with Storage;
has 'node' => (is => 'rw');
has 'children' => (
is => 'ro',
isa => 'ArrayRef',
default => sub {[]}
);
has 'parent' => (
metaclass => 'DoNotSerialize',
is => 'rw',
isa => 'Tree',
);
sub add_child {
my ($self, $child) = @_;
$child->parent($self);
push @{$self->children} => $child;
}
}
{
my $t = Tree->new(node => 100);
isa_ok($t, 'Tree');
is_deeply(
$t->pack,
{
__CLASS__ => 'Tree',
node => 100,
children => [],
},
'... got the right packed version');
my $t2 = Tree->new(node => 200);
isa_ok($t2, 'Tree');
$t->add_child($t2);
is_deeply($t->children, [ $t2 ], '... got the right children in $t');
is($t2->parent, $t, '... created the cycle correctly');
isa_ok($t2->parent, 'Tree');
is_deeply(
$t->pack,
{
__CLASS__ => 'Tree',
node => 100,
children => [
{
__CLASS__ => 'Tree',
node => 200,
children => [],
}
],
},
'... got the right packed version (with parent attribute skipped in child)');
is_deeply(
$t2->pack,
{
__CLASS__ => 'Tree',
node => 200,
children => [],
},
'... got the right packed version (with parent attribute skipped)');
}