X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F01-basic.t;h=dab6a3f3db548c53d443dc8850d60157aa120386;hb=bb4a98dc91f85fd0f14f85fdcb7c620aecbd33de;hp=5b57cf80852b6f2af66fafc3b9a6bc14687767f7;hpb=2429fb7e636733a986bb4211b1e049418284c25e;p=gitmo%2FMooseX-AlwaysCoerce.git diff --git a/t/01-basic.t b/t/01-basic.t index 5b57cf8..dab6a3f 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -1,8 +1,9 @@ -#!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 3; +use Test::More; +use Test::Fatal; +use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; { package MyClass; @@ -13,15 +14,91 @@ use Test::More tests => 3; subtype 'MyType', as 'Int'; coerce 'MyType', from 'Str', via { length $_ }; + subtype 'Uncoerced', as 'Int'; + has foo => (is => 'rw', isa => 'MyType'); class_has bar => (is => 'rw', isa => 'MyType'); + + class_has baz => (is => 'rw', isa => 'MyType', coerce => 0); + + has quux => (is => 'rw', isa => 'MyType', coerce => 0); + + has uncoerced_attr => (is => 'rw', isa => 'Uncoerced'); + + class_has uncoerced_class_attr => (is => 'rw', isa => 'Uncoerced'); + + has untyped_attr => (is => 'rw'); + + class_has untyped_class_attr => (is => 'rw'); } ok( (my $instance = MyClass->new), 'instance' ); -eval { $instance->foo('bar') }; -ok( (!$@), 'attribute coercion ran' ); +is( + exception { + $instance->foo('bar'); + is $instance->foo, 3; + }, + undef, + 'attribute coercion ran', +); + +is( + exception { + $instance->bar('baz'); + is $instance->bar, 3; + }, + undef, + 'class attribute coercion ran', +); + +isnt( + exception { $instance->baz('quux') }, + undef, + 'class attribute coercion did not run with coerce => 0', +); + +isnt( + exception{ $instance->quux('mtfnpy') }, + undef, + 'attribute coercion did not run with coerce => 0', +); + +is( + exception { + $instance->uncoerced_attr(10); + is $instance->uncoerced_attr(10), 10; + }, + undef, + 'set attribute having type with no coercion and no coerce=0', +); + +is( + exception { + $instance->uncoerced_class_attr(10); + is $instance->uncoerced_class_attr(10), 10; + }, + undef, + 'set class attribute having type with no coercion and no coerce=0', +); + +is( + exception { + $instance->untyped_attr(10); + is $instance->untyped_attr, 10; + }, + undef, + 'set untyped attribute', +); + +is( + exception { + $instance->untyped_class_attr(10); + is $instance->untyped_class_attr, 10; + }, + undef, + 'set untyped class attribute', +); -eval { $instance->bar('baz') }; -ok( (!$@), 'class attribute coercion ran' ); +done_testing;