From: Arthur Axel 'fREW' Schmidt Date: Sat, 13 Nov 2010 05:53:08 +0000 (-0600) Subject: initial test for coerce X-Git-Tag: release_0.009009~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c9533c74d5b1cc06c19d3201a9dd01c2ada13bb;p=gitmo%2FRole-Tiny.git initial test for coerce --- diff --git a/t/accessor-coerce.t b/t/accessor-coerce.t new file mode 100644 index 0000000..76381bd --- /dev/null +++ b/t/accessor-coerce.t @@ -0,0 +1,85 @@ +use strictures 1; +use Test::More; +use Test::Fatal; + +sub run_for { + my $class = shift; + + my $obj = $class->new(plus_three => 1); + + is($obj->plus_three, 4, "initial value set (${class})"); + + $obj->plus_three(4); + + is($obj->plus_three, 7, 'Value changes after set'); +} + +{ + package Foo; + + use Moo; + + has plus_three => ( + is => 'rw', + coerce => sub { $_[0] + 3 } + ); +} + +run_for 'Foo'; + +{ + package Bar; + + use Sub::Quote; + use Moo; + + has plus_three => ( + is => 'rw', + coerce => quote_sub q{ + my ($x) = @_; + $x + 3 + } + ); +} + +run_for 'Bar'; + +{ + package Baz; + + use Sub::Quote; + use Moo; + + has plus_three => ( + is => 'rw', + isa => quote_sub( + q{ + my ($value) = @_; + $value + $plus + }, + { '$plus' => \3 } + ) + ); +} + +run_for 'Baz'; + +{ + package Biff; + + use Sub::Quote; + use Moo; + + has dies => ( + is => 'rw', + isa => quote_sub( + q{ + die 'could not add three!' + }, + ) + ); +} + +like exception { Biff->new(plus_three => 1) }, 'could not add three!', 'Exception properly thrown'; + +done_testing;