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::Exception;
   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         => 'Str',        # type constraint is important
  69     );
  70
  71     has zot => (
  72         default     => sub { $$ },
  73         is          => 'rw',
  74     );
  75 }
  76
  77 {   my $bar = Bar->new( foo => $$ );
  78
  79     ok( $bar,                   "New object created" );
  80     is( $bar->foo, $$,          "   ->foo => $$" );
  81     is( $bar->zot, $$,          "   ->zot => $$" );
  82
  83     my $bpack = $bar->pack;
  84     is_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, foo => $$ });
  95     ok( $bar2,                  "   Unpacked correctly with foo => $$");
  96 }
  97
  98
  99
 100
 101