ugly proof of concept for parametrized types only
[gitmo/MooseX-Types.git] / t / 13_typedecorator.t
1 #!/usr/bin/env perl
2 use warnings;
3 use strict;
4
5 use Test::More tests => 10;
6 use FindBin;
7 use lib "$FindBin::Bin/lib";
8
9 {
10     package Test::MooseX::TypeLibrary::TypeDecorator;
11     
12     use Moose;
13     use DecoratorLibrary qw(
14         MyArrayRefBase
15         MyArrayRefInt01
16         MyArrayRefInt02
17     );
18     
19     has 'arrayrefbase' => (is=>'rw', isa=>MyArrayRefBase, coerce=>1);
20     has 'arrayrefint01' => (is=>'rw', isa=>MyArrayRefInt01, coerce=>1);
21 }
22
23 ## Make sure we have a 'create object sanity check'
24
25 ok my $type = Test::MooseX::TypeLibrary::TypeDecorator->new(),
26  => 'Created some sort of object';
27  
28 isa_ok $type, 'Test::MooseX::TypeLibrary::TypeDecorator'
29  => "Yes, it's the correct kind of object";
30
31 ## test arrayrefbase normal and coercion
32
33 ok $type->arrayrefbase([qw(a b c)])
34  => 'Assigned arrayrefbase qw(a b c)';
35  
36 is_deeply $type->arrayrefbase, [qw(a b c)],
37  => 'Assigment is correct';
38
39 ok $type->arrayrefbase('d,e,f')
40  => 'Assigned arrayrefbase d,e,f to test coercion';
41  
42 is_deeply $type->arrayrefbase, [qw(d e f)],
43  => 'Assigment and coercion is correct';
44
45 ## test arrayrefint01 normal and coercion
46
47 ok $type->arrayrefint01([qw(1 2 3)])
48  => 'Assigned arrayrefbase qw(1 2 3)';
49  
50 is_deeply $type->arrayrefint01, [qw(1 2 3)],
51  => 'Assigment is correct';
52
53 ok $type->arrayrefint01('4.5.6')
54  => 'Assigned arrayrefbase 4.5.6 to test coercion from Str';
55  
56 is_deeply $type->arrayrefint01, [qw(4 5 6)],
57  => 'Assigment and coercion is correct';
58
59 ok $type->arrayrefint01({a=>7,b=>8})
60  => 'Assigned arrayrefbase {a=>7,b=>8} to test coercion from HashRef';
61  
62 is_deeply $type->arrayrefint01, [qw(7 8)],
63  => 'Assigment and coercion is correct';
64  
65 #use Data::Dump qw/dump/;
66 #warn dump  MyArrayRefInt01;
67 #warn dump MyArrayRefBase->validate('aaa,bbb,ccc');