TODO test for RT#62351: native attribute coercion issues
[gitmo/Moose.git] / t / 070_native_traits / 013_array_coerce.t
CommitLineData
7ab4d55d 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
6
7{
8
9 package Foo;
10 use Moose;
11 use Moose::Util::TypeConstraints;
12
13 subtype 'UCArray', as 'ArrayRef[Str]', where {
14 !grep {/[a-z]/} @{$_};
15 };
16
17 coerce 'UCArray', from 'ArrayRef[Str]', via {
18 [ map { uc $_ } @{$_} ];
19 };
20
21 has array => (
22 traits => ['Array'],
23 is => 'rw',
24 isa => 'UCArray',
25 coerce => 1,
26 handles => {
27 push_array => 'push',
28 set_array => 'set',
29 },
30 );
31
32 our @TriggerArgs;
33
34 has lazy => (
35 traits => ['Array'],
36 is => 'rw',
37 isa => 'UCArray',
38 coerce => 1,
39 lazy => 1,
40 default => sub { ['a'] },
41 handles => {
42 push_lazy => 'push',
43 set_lazy => 'set',
44 },
45 trigger => sub { @TriggerArgs = @_ },
46 clearer => 'clear_lazy',
47 );
48}
49
50my $foo = Foo->new;
51
52{
53 $foo->array( [qw( A B C )] );
54
55 $foo->push_array('d');
56
57 is_deeply(
58 $foo->array, [qw( A B C D )],
59 'push coerces the array'
60 );
61
62 $foo->set_array( 1 => 'x' );
63
64 is_deeply(
65 $foo->array, [qw( A X C D )],
66 'set coerces the array'
67 );
68}
69
70{
71 $foo->push_lazy('d');
72
73 is_deeply(
74 $foo->lazy, [qw( A D )],
75 'push coerces the array - lazy'
76 );
77
78 is_deeply(
79 \@Foo::TriggerArgs,
80 [ $foo, [qw( A D )], ['A'] ],
81 'trigger receives expected arguments'
82 );
83
84 $foo->set_lazy( 2 => 'f' );
85
86 is_deeply(
87 $foo->lazy, [qw( A D F )],
88 'set coerces the array - lazy'
89 );
90
91 is_deeply(
92 \@Foo::TriggerArgs,
93 [ $foo, [qw( A D F )], [qw( A D )] ],
94 'trigger receives expected arguments'
95 );
96}
97
4490c1fe 98{
99 package Thing;
100 use Moose;
101 has thing => (
102 is => 'ro', isa => 'Str',
103 );
104}
105{
106 package Bar;
107 use Moose;
108 use Moose::Util::TypeConstraints;
109
110 class_type 'Thing';
111
112 coerce 'Thing'
113 => from 'Str'
114 => via { Thing->new(thing => $_) };
115
116 subtype 'ArrayRefOfThings'
117 => as 'ArrayRef[Thing]';
118
119 coerce 'ArrayRefOfThings'
120 => from 'ArrayRef[Str]'
121 => via { [ map { Thing->new(thing => $_) } @$_ ] };
122
123 coerce 'ArrayRefOfThings'
124 => from 'Str'
125 => via { [ Thing->new(thing => $_) ] };
126
127 coerce 'ArrayRefOfThings'
128 => from 'Thing'
129 => via { [ $_ ] };
130
131 has array => (
132 traits => ['Array'],
133 is => 'rw',
134 isa => 'ArrayRefOfThings',
135 coerce => 1,
136 handles => {
137 push_array => 'push',
138 set_array => 'set',
139 },
140 );
141}
142
143my $bar;
144TODO: {
145 $bar = Bar->new(array => [ qw( a b c ) ]);
146 #print $bar->dump(3);
147
148 todo_skip 'coercion in push dies here!', 1;
149
150 $bar->push_array('d');
151 #print $bar->dump(3);
152
153 is_deeply(
154 $bar->array, [qw( a b c d )],
155 'push coerces the array'
156 );
157
158}
159
7ab4d55d 160done_testing;