t/002_basic_w_subtypes.t

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