support attributes without isa, better tests, release
[gitmo/MooseX-AlwaysCoerce.git] / t / 03-roles.t
CommitLineData
0d42c8e8 1#!/usr/bin/env perl
2use strict;
3use warnings;
4
bb7cca58 5use Test::More tests => 10;
0d42c8e8 6use Test::Exception;
7use Test::NoWarnings;
8
9{
10 package MyRole;
11 use Moose::Role;
12 use MooseX::AlwaysCoerce;
13 use Moose::Util::TypeConstraints;
14
15 subtype 'MyType', as 'Int';
16 coerce 'MyType', from 'Str', via { length $_ };
17
18 subtype 'Uncoerced', as 'Int';
19
20 has foo => (is => 'rw', isa => 'MyType');
21
22 class_has bar => (is => 'rw', isa => 'MyType');
23
24 class_has baz => (is => 'rw', isa => 'MyType', coerce => 0);
25
26 has quux => (is => 'rw', isa => 'MyType', coerce => 0);
27
28 has uncoerced_attr => (is => 'rw', isa => 'Uncoerced');
29
30 class_has uncoerced_class_attr => (is => 'rw', isa => 'Uncoerced');
bb7cca58 31
32 has untyped_attr => (is => 'rw');
33
34 class_has untyped_class_attr => (is => 'rw');
0d42c8e8 35}
36
37{
38 package MyClass;
39 use Moose;
40 with 'MyRole';
41}
42
43ok( (my $instance = MyClass->new), 'instance' );
44
13005566 45{
46 local $TODO = 'waiting on Moose changes for role support';
47
bb7cca58 48 lives_and {
49 $instance->foo('bar');
50 is $instance->foo, 3;
51 } 'attribute coercion ran';
13005566 52}
0d42c8e8 53
bb7cca58 54lives_and {
55 $instance->bar('baz');
56 is $instance->bar, 3;
57} 'class attribute coercion ran';
0d42c8e8 58
59dies_ok { $instance->baz('quux') }
60 'class attribute coercion did not run with coerce => 0';
61
62dies_ok { $instance->quux('mtfnpy') }
63 'attribute coercion did not run with coerce => 0';
64
bb7cca58 65lives_and {
66 $instance->uncoerced_attr(10);
67 is $instance->uncoerced_attr(10), 10;
68} 'set attribute having type with no coercion and no coerce=0';
69
70lives_and {
71 $instance->uncoerced_class_attr(10);
72 is $instance->uncoerced_class_attr(10), 10;
73} 'set class attribute having type with no coercion and no coerce=0';
74
75lives_and {
76 $instance->untyped_attr(10);
77 is $instance->untyped_attr, 10;
78} 'set untyped attribute';
79
80lives_and {
81 $instance->untyped_class_attr(10);
82 is $instance->untyped_class_attr, 10;
83} 'set untyped class attribute';