view release on metacpan or  search on metacpan

t/10.t  view on Meta::CPAN

#!perl -w

use strict;

use Test::More;

# Testing _check_subobj()


use Array::To::Moose qw(array_to_moose throw_multiple_rows);

BEGIN {
  eval "use Test::Exception";
  plan skip_all => "Test::Exception needed" if $@;
}

plan tests => 11;

#----------------------------------------
package Sibling;
use namespace::autoclean;
use Moose;
use MooseX::StrictConstructor;

has [ qw( name sex ) ] => (is => 'rw', isa => 'Str' );

__PACKAGE__->meta->make_immutable;

#----------------------------------------
package Cousin;
use namespace::autoclean;
use Moose;
use MooseX::StrictConstructor;

has [ qw( name sex ) ] => (is => 'rw', isa => 'Str' );

__PACKAGE__->meta->make_immutable;

#----------------------------------------
package Person;
use namespace::autoclean;
use Moose;
use MooseX::StrictConstructor;

has [ qw( name sex ) ] => (is => 'rw', isa =>          'Str' );
has SibH               => (is => 'rw', isa => 'HashRef[Sibling]' );
has SibA               => (is => 'rw', isa => 'ArrayRef[Sibling]');
has SibB               => (is => 'rw', isa =>           'Sibling'); # (B)are

__PACKAGE__->meta->make_immutable;

package main;

my @s1 = ( 'John', 'm' );
my @s2 = ( 'Jane', 'f' );

my @p1 = ( 'Bill', 'm' );
my @p2 = ( 'Pam',  'f' );

my $data = [ [ @p1, @s1 ],
             [ @p1, @s2 ],
             [ @p2, @s1 ],
             [ @p2, @s2 ],
           ];

# Moose says HashRef, desc says ArrayRef
#----------------------------------------
my $desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibH  => {
             class => 'Sibling',
             name  => 2,
             sex   => 3,
           }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibH' has type 'HashRef\[Sibling\]' but your.*of type 'ARRAY'/,
'_check_subobj(): Moose says HashRef[`a], desc says ArrayRef[`a]';

# Moose says HashRef[`a] desc says Hashref[`b]
#----------------------------------------
$desc = {  class => 'Person',
              name  => 0,
              sex   => 1,
              SibH  => {
                class => 'Cousin',    # !! should be Sibling
                key   => 2,
                name  => 2,
                sex   => 3,
              }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibH' has type 'HashRef\[Sibling\]' but your.*of type 'HashRef\[Cousin\]'/,
  '_check_subobj(): Moose says HashRef[`a], desc says HashRef[`b]';

# Moose and desc both say HashRef[`a]
#----------------------------------------
$desc = {  class => 'Person',