X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F004_w_cycles.t;h=f7e60c1a8191c87730bbeca97c123f2e35737dac;hb=3513de05de63c95635c9af8a5b05261f7fabc44d;hp=d08c9aef1b9c50e1d2b6da364ed5c840f8188274;hpb=7eb5dc635e43005020528128b012527cb5707559;p=gitmo%2FMooseX-Storage.git

diff --git a/t/004_w_cycles.t b/t/004_w_cycles.t
index d08c9ae..f7e60c1 100644
--- a/t/004_w_cycles.t
+++ b/t/004_w_cycles.t
@@ -3,13 +3,23 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 18;
 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;
@@ -43,5 +53,131 @@ BEGIN {
     '... 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)');
+}
+
+### this fails with cycle detection on
+{   package Double;
+    use Moose;
+    use MooseX::Storage;
+    with Storage;
+    
+    has 'x' => ( is => 'rw', isa => 'HashRef' );
+    has 'y' => ( is => 'rw', isa => 'HashRef' );
+}
+
+{   my $ref = {};
+
+    my $double = Double->new( 'x' => $ref, 'y' => $ref );
+
+    ### currently, the cycle checker's too naive to figure out this is not
+    ### a problem, pass an empty hashref to the 2nd test to make sure it
+    ### doesn't warn/die
+    TODO: {
+        local $TODO = "Cycle check is too naive";
+        my $pack = eval { $double->pack; };
+        ok( $pack,              "Object with 2 references packed" );
+        ok( Double->unpack( $pack || {} ),
+                                "   And unpacked again" );
+    }
+    
+    my $pack = $double->pack( engine_traits => [qw/DisableCycleDetection/] );
+    ok( $pack,                  "   Object packs when cycle check is disabled");
+    ok( Double->unpack( $pack ),
+                                "   And unpacked again" );
+
+}    
+
+### the same as above, but now done with a trait
+### this fails with cycle detection on
+{   package DoubleNoCycle;
+    use Moose;
+    use MooseX::Storage;
+    with Storage( traits => ['DisableCycleDetection'] );
+    
+    has 'x' => ( is => 'rw', isa => 'HashRef' );
+    has 'y' => ( is => 'rw', isa => 'HashRef' );
+}
 
+{   my $ref = {};
 
+    my $double = DoubleNoCycle->new( 'x' => $ref, 'y' => $ref );
+    my $pack = $double->pack;
+    ok( $pack,              "Object packs with DisableCycleDetection trait");
+    ok( DoubleNoCycle->unpack( $pack ),
+                            "   Unpacked again" );
+}