X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F008_do_not_serialize.t;h=200e90b6f7e326ef02c148d70b85db79e864bde0;hb=9d3c60f5f35a8d28951049e8daccd9f67c22f9aa;hp=bdf2091d2266633b080049d6d8a4547237a71e28;hpb=38c636f9fb20e5d22112f7c3842aa9b5661d4403;p=gitmo%2FMooseX-Storage.git

diff --git a/t/008_do_not_serialize.t b/t/008_do_not_serialize.t
index bdf2091..200e90b 100644
--- a/t/008_do_not_serialize.t
+++ b/t/008_do_not_serialize.t
@@ -3,8 +3,8 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
-use Test::Exception;
+use Test::More tests => 13;
+use Test::Fatal;
 
 BEGIN {
     use_ok('MooseX::Storage');
@@ -37,22 +37,66 @@ BEGIN {
     1;
 }
 
-my $foo = Foo->new;
-isa_ok($foo, 'Foo');
-
-is($foo->bar, 'BAR', '... got the value we expected');
-is($foo->baz, 'BAZ', '... got the value we expected');
-is($foo->gorch, 'GORCH', '... got the value we expected');
+{   my $foo = Foo->new;
+    isa_ok($foo, 'Foo');
+    
+    is($foo->bar, 'BAR', '... got the value we expected');
+    is($foo->baz, 'BAZ', '... got the value we expected');
+    is($foo->gorch, 'GORCH', '... got the value we expected');
+    
+    is_deeply(
+        $foo->pack,
+        {
+            __CLASS__ => 'Foo',
+            gorch     => 'GORCH'
+        },
+        '... got the right packed class data'
+    );
+}
 
-is_deeply(
-    $foo->pack,
-    {
-        __CLASS__ => 'Foo',
-        gorch     => 'GORCH'
-    },
-    '... got the right packed class data'
-);
+### more involved test; required attribute that's not serialized
+{   package Bar;
+    use Moose;
+    use MooseX::Storage;
 
+    with Storage;
 
+    has foo => (
+        metaclass   => 'DoNotSerialize',
+        required    => 1,
+        is          => 'rw',
+        isa         => 'Object',        # type constraint is important
+    );
+    
+    has zot => (
+        default     => sub { $$ },
+        is          => 'rw',
+    );        
+}
 
+{   my $obj = bless {};
+    my $bar = Bar->new( foo => $obj );
+    
+    ok( $bar,                   "New object created" );
+    is( $bar->foo, $obj,        "   ->foo => $obj" );
+    is( $bar->zot, $$,          "   ->zot => $$" );
+    
+    my $bpack = $bar->pack;
+    is_deeply(
+        $bpack,
+        {   __CLASS__   => 'Bar',
+            zot         => $$,
+        },                      "   Packed correctly" );
+        
+    eval { Bar->unpack( $bpack ) };
+    ok( $@,                     "   Unpack without required attribute fails" );
+    like( $@, qr/foo/,          "       Proper error recorded" );
+        
+    my $bar2 = Bar->unpack( $bpack, inject => { foo => bless {} } );
+    ok( $bar2,                  "   Unpacked correctly with foo => Object"); 
+}        
+            
+        
+        
+