t/070_basic_maybe.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 22;
   7 use Test::Deep;
   8
   9 BEGIN {
  10     use_ok('MooseX::Storage');
  11 }
  12
  13 {
  14
  15     package Foo;
  16     use Moose;
  17     use MooseX::Storage;
  18
  19     with Storage;
  20
  21     has 'number'  => ( is => 'ro', isa => 'Maybe[Int]' );
  22     has 'string'  => ( is => 'ro', isa => 'Maybe[Str]' );
  23     has 'boolean' => ( is => 'ro', isa => 'Maybe[Bool]' );
  24     has 'float'   => ( is => 'ro', isa => 'Maybe[Num]' );
  25     has 'array'   => ( is => 'ro', isa => 'Maybe[ArrayRef]' );
  26     has 'hash'    => ( is => 'ro', isa => 'Maybe[HashRef]' );
  27     has 'object'  => ( is => 'ro', isa => 'Maybe[Foo]' );
  28 }
  29
  30 {
  31     my $foo = Foo->new(
  32         number  => 10,
  33         string  => 'foo',
  34         boolean => 1,
  35         float   => 10.5,
  36         array   => [ 1 .. 10 ],
  37         hash    => { map { $_ => undef } ( 1 .. 10 ) },
  38         object  => Foo->new( number => 2 ),
  39     );
  40     isa_ok( $foo, 'Foo' );
  41
  42     cmp_deeply(
  43         $foo->pack,
  44         {
  45             __CLASS__ => 'Foo',
  46             number    => 10,
  47             string    => 'foo',
  48             boolean   => 1,
  49             float     => 10.5,
  50             array     => [ 1 .. 10 ],
  51             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  52             object    => {
  53                             __CLASS__ => 'Foo',
  54                             number    => 2
  55                          },
  56         },
  57         '... got the right frozen class'
  58     );
  59 }
  60
  61 {
  62     my $foo = Foo->unpack(
  63         {
  64             __CLASS__ => 'Foo',
  65             number    => 10,
  66             string    => 'foo',
  67             boolean   => 1,
  68             float     => 10.5,
  69             array     => [ 1 .. 10 ],
  70             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  71             object    => {
  72                             __CLASS__ => 'Foo',
  73                             number    => 2
  74                          },
  75         }
  76     );
  77     isa_ok( $foo, 'Foo' );
  78
  79     is( $foo->number, 10,    '... got the right number' );
  80     is( $foo->string, 'foo', '... got the right string' );
  81     ok( $foo->boolean,       '... got the right boolean' );
  82     is( $foo->float,  10.5,  '... got the right float' );
  83     cmp_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
  84     cmp_deeply(
  85         $foo->hash,
  86         { map { $_ => undef } ( 1 .. 10 ) },
  87         '... got the right hash'
  88     );
  89
  90     isa_ok( $foo->object, 'Foo' );
  91     is( $foo->object->number, 2,
  92         '... got the right number (in the embedded object)' );
  93 }
  94
  95
  96 {
  97
  98     package Foo;
  99     use Moose;
 100     use Moose::Util::TypeConstraints;
 101     use MooseX::Storage;
 102
 103     use Scalar::Util 'looks_like_number';
 104
 105     with Storage;
 106
 107     subtype 'Natural'
 108         => as 'Int'
 109         => where { $_ > 0 };
 110
 111     subtype 'HalfNum'
 112         => as 'Num'
 113         => where { "$_" =~ /\.5$/ };
 114
 115     subtype 'FooString'
 116         => as 'Str'
 117         => where { lc($_) eq 'foo' };
 118
 119     subtype 'IntArray'
 120         => as 'ArrayRef'
 121         => where { scalar grep { looks_like_number($_) } @{$_} };
 122
 123     subtype 'UndefHash'
 124         => as 'HashRef'
 125         => where { scalar grep { !defined($_) } values %{$_} };
 126
 127     has 'number' => ( is => 'ro', isa => 'Maybe[Natural]' );
 128     has 'string' => ( is => 'ro', isa => 'Maybe[FooString]' );
 129     has 'float'  => ( is => 'ro', isa => 'Maybe[HalfNum]' );
 130     has 'array'  => ( is => 'ro', isa => 'Maybe[IntArray]' );
 131     has 'hash'   => ( is => 'ro', isa => 'Maybe[UndefHash]' );
 132     has 'object' => ( is => 'ro', isa => 'Maybe[Foo]' );
 133 }
 134
 135 {
 136     my $foo = Foo->new(
 137         number => 10,
 138         string => 'foo',
 139         float  => 10.5,
 140         array  => [ 1 .. 10 ],
 141         hash   => { map { $_ => undef } ( 1 .. 10 ) },
 142         object => Foo->new( number => 2 ),
 143     );
 144     isa_ok( $foo, 'Foo' );
 145
 146     cmp_deeply(
 147         $foo->pack,
 148         {
 149             __CLASS__ => 'Foo',
 150             number    => 10,
 151             string    => 'foo',
 152             float     => 10.5,
 153             array     => [ 1 .. 10 ],
 154             hash      => { map { $_ => undef } ( 1 .. 10 ) },
 155             object    => {
 156                             __CLASS__ => 'Foo',
 157                             number    => 2
 158                          },
 159         },
 160         '... got the right frozen class'
 161     );
 162 }
 163
 164 {
 165     my $foo = Foo->unpack(
 166         {
 167             __CLASS__ => 'Foo',
 168             number    => 10,
 169             string    => 'foo',
 170             float     => 10.5,
 171             array     => [ 1 .. 10 ],
 172             hash      => { map { $_ => undef } ( 1 .. 10 ) },
 173             object    => {
 174                             __CLASS__ => 'Foo',
 175                             number    => 2
 176                          },
 177         }
 178     );
 179     isa_ok( $foo, 'Foo' );
 180
 181     is( $foo->number, 10,    '... got the right number' );
 182     is( $foo->string, 'foo', '... got the right string' );
 183     is( $foo->float,  10.5,  '... got the right float' );
 184     cmp_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
 185     cmp_deeply(
 186         $foo->hash,
 187         { map { $_ => undef } ( 1 .. 10 ) },
 188         '... got the right hash'
 189     );
 190
 191     isa_ok( $foo->object, 'Foo' );
 192     is( $foo->object->number, 2,
 193         '... got the right number (in the embedded object)' );
 194 }