t/008_do_not_serialize.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 13;
   5 use Test::Deep;
   6 use Test::Fatal;
   7
   8 BEGIN {
   9     use_ok('MooseX::Storage');
  10 }
  11
  12 {
  13     package Foo;
  14     use Moose;
  15     use MooseX::Storage;
  16
  17     with Storage;
  18
  19     has 'bar' => (
  20         metaclass => 'DoNotSerialize',
  21         is        => 'rw',
  22         default   => sub { 'BAR' }
  23     );
  24
  25     has 'baz' => (
  26         traits  => [ 'DoNotSerialize' ],
  27         is      => 'rw',
  28         default => sub { 'BAZ' }
  29     );
  30
  31     has 'gorch' => (
  32         is      => 'rw',
  33         default => sub { 'GORCH' }
  34     );
  35
  36     1;
  37 }
  38
  39 {   my $foo = Foo->new;
  40     isa_ok($foo, 'Foo');
  41
  42     is($foo->bar, 'BAR', '... got the value we expected');
  43     is($foo->baz, 'BAZ', '... got the value we expected');
  44     is($foo->gorch, 'GORCH', '... got the value we expected');
  45
  46     cmp_deeply(
  47         $foo->pack,
  48         {
  49             __CLASS__ => 'Foo',
  50             gorch     => 'GORCH'
  51         },
  52         '... got the right packed class data'
  53     );
  54 }
  55
  56 ### more involved test; required attribute that's not serialized
  57 {   package Bar;
  58     use Moose;
  59     use MooseX::Storage;
  60
  61     with Storage;
  62
  63     has foo => (
  64         metaclass   => 'DoNotSerialize',
  65         required    => 1,
  66         is          => 'rw',
  67         isa         => 'Object',        # type constraint is important
  68     );
  69
  70     has zot => (
  71         default     => sub { $$ },
  72         is          => 'rw',
  73     );
  74 }
  75
  76 {   my $obj = bless {};
  77     my $bar = Bar->new( foo => $obj );
  78
  79     ok( $bar,                   "New object created" );
  80     is( $bar->foo, $obj,        "   ->foo => $obj" );
  81     is( $bar->zot, $$,          "   ->zot => $$" );
  82
  83     my $bpack = $bar->pack;
  84     cmp_deeply(
  85         $bpack,
  86         {   __CLASS__   => 'Bar',
  87             zot         => $$,
  88         },                      "   Packed correctly" );
  89
  90     eval { Bar->unpack( $bpack ) };
  91     ok( $@,                     "   Unpack without required attribute fails" );
  92     like( $@, qr/foo/,          "       Proper error recorded" );
  93
  94     my $bar2 = Bar->unpack( $bpack, inject => { foo => bless {} } );
  95     ok( $bar2,                  "   Unpacked correctly with foo => Object");
  96 }
  97
  98
  99
 100
 101