t/008_do_not_serialize.t

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