t/070_basic_maybe.t

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