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