t/002_basic_w_subtypes.t

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