t/13_typedecorator.t

   1 #!/usr/bin/env perl
   2 use warnings;
   3 use strict;
   4
   5 use Test::More tests => 26;
   6 use Test::Exception;
   7 use FindBin;
   8 use lib "$FindBin::Bin/lib";
   9
  10 {
  11     package Test::MooseX::TypeLibrary::TypeDecorator;
  12
  13     use Moose;
  14     use MooseX::Types::Moose qw(
  15         Int
  16     );
  17     use DecoratorLibrary qw(
  18         MyArrayRefBase MyArrayRefInt01 MyArrayRefInt02
  19     );
  20
  21     has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
  22     has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1);
  23     has 'arrayrefint02' => (is=>'rw', isa=>MyArrayRefInt02, coerce=>1);
  24     has 'arrayrefint03' => (is=>'rw', isa=>MyArrayRefBase[Int]);
  25 }
  26
  27 ## Make sure we have a 'create object sanity check'
  28
  29 ok my $type = Test::MooseX::TypeLibrary::TypeDecorator->new(),
  30  => 'Created some sort of object';
  31
  32 isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator'
  33  => "Yes, it's the correct kind of object";
  34
  35 ## test arrayrefbase normal and coercion
  36
  37 ok $type->arrayrefbase([qw(a b c)])
  38  => 'Assigned arrayrefbase qw(a b c)';
  39
  40 is_deeply $type->arrayrefbase, [qw(a b c)],
  41  => 'Assignment is correct';
  42
  43 ok $type->arrayrefbase('d,e,f')
  44  => 'Assignment arrayrefbase d,e,f to test coercion';
  45
  46 is_deeply $type->arrayrefbase, [qw(d e f)],
  47  => 'Assignment and coercion is correct';
  48
  49 ## test arrayrefint01 normal and coercion
  50
  51 ok $type->arrayrefint01([qw(1 2 3)])
  52  => 'Assignment arrayrefint01 qw(1 2 3)';
  53
  54 is_deeply $type->arrayrefint01, [qw(1 2 3)],
  55  => 'Assignment is correct';
  56
  57 ok $type->arrayrefint01('4.5.6')
  58  => 'Assigned arrayrefint01 4.5.6 to test coercion from Str';
  59
  60 is_deeply $type->arrayrefint01, [qw(4 5 6)],
  61  => 'Assignment and coercion is correct';
  62
  63 ok $type->arrayrefint01({a=>7,b=>8})
  64  => 'Assigned arrayrefint01 {a=>7,b=>8} to test coercion from HashRef';
  65
  66 is_deeply $type->arrayrefint01, [qw(7 8)],
  67  => 'Assignment and coercion is correct';
  68
  69 throws_ok sub {
  70     $type->arrayrefint01([qw(a b c)])
  71 }, qr/Attribute \(arrayrefint01\) does not pass the type constraint/ => 'Dies when values are strings';
  72
  73 ## test arrayrefint02 normal and coercion
  74
  75 ok $type->arrayrefint02([qw(1 2 3)])
  76  => 'Assigned arrayrefint02 qw(1 2 3)';
  77
  78 is_deeply $type->arrayrefint02, [qw(1 2 3)],
  79  => 'Assignment is correct';
  80
  81 ok $type->arrayrefint02('4:5:6')
  82  => 'Assigned arrayrefint02 4:5:6 to test coercion from Str';
  83
  84 is_deeply $type->arrayrefint02, [qw(4 5 6)],
  85  => 'Assignment and coercion is correct';
  86
  87 ok $type->arrayrefint02({a=>7,b=>8})
  88  => 'Assigned arrayrefint02 {a=>7,b=>8} to test coercion from HashRef';
  89
  90 is_deeply $type->arrayrefint02, [qw(7 8)],
  91  => 'Assignment and coercion is correct';
  92
  93 ok $type->arrayrefint02({a=>'AA',b=>'BBB', c=>'CCCCCCC'})
  94  => "Assigned arrayrefint02 {a=>'AA',b=>'BBB', c=>'CCCCCCC'} to test coercion from HashRef";
  95
  96 is_deeply $type->arrayrefint02, [qw(2 3 7)],
  97  => 'Assignment and coercion is correct';
  98
  99 ok $type->arrayrefint02({a=>[1,2],b=>[3,4]})
 100  => "Assigned arrayrefint02 {a=>[1,2],b=>[3,4]} to test coercion from HashRef";
 101
 102 is_deeply $type->arrayrefint02, [qw(1 2 3 4)],
 103  => 'Assignment and coercion is correct';
 104
 105 # test arrayrefint03
 106
 107 ok $type->arrayrefint03([qw(11 12 13)])
 108  => 'Assigned arrayrefint01 qw(11 12 13)';
 109
 110 is_deeply $type->arrayrefint03, [qw(11 12 13)],
 111  => 'Assignment is correct';
 112
 113 throws_ok sub {
 114     $type->arrayrefint03([qw(a b c)])
 115 }, qr/Attribute \(arrayrefint03\) does not pass the type constraint/ => 'Dies when values are strings';