t/002_basic_w_subtypes.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 11;
   5 use Test::Deep;
   6
   7 BEGIN {
   8     use_ok('MooseX::Storage');
   9 }
  10
  11 =pod
  12
  13 This extends the 001_basic test to
  14 show that subtypes will DWIM in most
  15 cases.
  16
  17 =cut
  18
  19 {
  20
  21     package Foo;
  22     use Moose;
  23     use Moose::Util::TypeConstraints;
  24     use MooseX::Storage;
  25
  26     use Scalar::Util 'looks_like_number';
  27
  28     with Storage;
  29
  30     subtype 'Natural'
  31         => as 'Int'
  32         => where { $_ > 0 };
  33
  34     subtype 'HalfNum'
  35         => as 'Num'
  36         => where { "$_" =~ /\.5$/ };
  37
  38     subtype 'FooString'
  39         => as 'Str'
  40         => where { lc($_) eq 'foo' };
  41
  42     subtype 'IntArray'
  43         => as 'ArrayRef'
  44         => where { scalar grep { looks_like_number($_) } @{$_} };
  45
  46     subtype 'UndefHash'
  47         => as 'HashRef'
  48         => where { scalar grep { !defined($_) } values %{$_} };
  49
  50     has 'number' => ( is => 'ro', isa => 'Natural' );
  51     has 'string' => ( is => 'ro', isa => 'FooString' );
  52     has 'float'  => ( is => 'ro', isa => 'HalfNum' );
  53     has 'array'  => ( is => 'ro', isa => 'IntArray' );
  54     has 'hash'   => ( is => 'ro', isa => 'UndefHash' );
  55     has 'object' => ( is => 'ro', isa => 'Foo' );
  56 }
  57
  58 {
  59     my $foo = Foo->new(
  60         number => 10,
  61         string => 'foo',
  62         float  => 10.5,
  63         array  => [ 1 .. 10 ],
  64         hash   => { map { $_ => undef } ( 1 .. 10 ) },
  65         object => Foo->new( number => 2 ),
  66     );
  67     isa_ok( $foo, 'Foo' );
  68
  69     cmp_deeply(
  70         $foo->pack,
  71         {
  72             __CLASS__ => 'Foo',
  73             number    => 10,
  74             string    => 'foo',
  75             float     => 10.5,
  76             array     => [ 1 .. 10 ],
  77             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  78             object    => {
  79                             __CLASS__ => 'Foo',
  80                             number    => 2
  81                          },
  82         },
  83         '... got the right frozen class'
  84     );
  85 }
  86
  87 {
  88     my $foo = Foo->unpack(
  89         {
  90             __CLASS__ => 'Foo',
  91             number    => 10,
  92             string    => 'foo',
  93             float     => 10.5,
  94             array     => [ 1 .. 10 ],
  95             hash      => { map { $_ => undef } ( 1 .. 10 ) },
  96             object    => {
  97                             __CLASS__ => 'Foo',
  98                             number    => 2
  99                          },
 100         }
 101     );
 102     isa_ok( $foo, 'Foo' );
 103
 104     is( $foo->number, 10,    '... got the right number' );
 105     is( $foo->string, 'foo', '... got the right string' );
 106     is( $foo->float,  10.5,  '... got the right float' );
 107     cmp_deeply( $foo->array, [ 1 .. 10 ], '... got the right array' );
 108     cmp_deeply(
 109         $foo->hash,
 110         { map { $_ => undef } ( 1 .. 10 ) },
 111         '... got the right hash'
 112     );
 113
 114     isa_ok( $foo->object, 'Foo' );
 115     is( $foo->object->number, 2,
 116         '... got the right number (in the embedded object)' );
 117 }