From: Dave Rolsky <autarch@urth.org>
Date: Sun, 26 Sep 2010 01:59:27 +0000 (-0500)
Subject: Add tests for coercing native Hash trait
X-Git-Tag: 1.15~79
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a9c1f4ec28ca12764d1b3b29eeed88b43c46ab60;p=gitmo%2FMoose.git

Add tests for coercing native Hash trait
---

diff --git a/t/070_native_traits/053_hash_coerce.t b/t/070_native_traits/053_hash_coerce.t
new file mode 100644
index 0000000..f05b144
--- /dev/null
+++ b/t/070_native_traits/053_hash_coerce.t
@@ -0,0 +1,77 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+{
+
+    package Foo;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    subtype 'UCHash', as 'HashRef[Str]', where {
+        !grep {/[a-z]/} values %{$_};
+    };
+
+    coerce 'UCHash', from 'HashRef[Str]', via {
+        $_ = uc $_ for values %{$_};
+        $_;
+    };
+
+    has hash => (
+        traits  => ['Hash'],
+        is      => 'rw',
+        isa     => 'UCHash',
+        coerce  => 1,
+        handles => {
+            set_key => 'set',
+        },
+    );
+
+    our @TriggerArgs;
+
+    has lazy => (
+        traits  => ['Hash'],
+        is      => 'rw',
+        isa     => 'UCHash',
+        coerce  => 1,
+        lazy    => 1,
+        default => sub { { x => 'a' } },
+        handles => {
+            set_lazy => 'set',
+        },
+        trigger => sub { @TriggerArgs = @_ },
+        clearer => 'clear_lazy',
+    );
+}
+
+my $foo = Foo->new;
+
+{
+    $foo->hash( { x => 'A', y => 'B' } );
+
+    $foo->set_key( z => 'c' );
+
+    is_deeply(
+        $foo->hash, { x => 'A', y => 'B', z => 'C' },
+        'set coerces the hash'
+    );
+}
+
+{
+    $foo->set_lazy( y => 'b' );
+
+    is_deeply(
+        $foo->lazy, { x => 'A', y => 'B' },
+        'set coerces the hash - lazy'
+    );
+
+    is_deeply(
+        \@Foo::TriggerArgs,
+        [ $foo, { x => 'A', y => 'B' }, { x => 'A' } ],
+        'trigger receives expected arguments'
+    );
+}
+
+done_testing;