From: Dave Rolsky <autarch@urth.org>
Date: Mon, 25 Oct 2010 21:36:42 +0000 (-0500)
Subject: Make the Hash->set delegation coerce new member values
X-Git-Tag: 1.18~59
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d3a83c085d134fc089cc59ee7d434e0d31d8e580;p=gitmo%2FMoose.git

Make the Hash->set delegation coerce new member values
---

diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm
index 9123490..655b477 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/set.pm
@@ -3,6 +3,7 @@ package Moose::Meta::Method::Accessor::Native::Hash::set;
 use strict;
 use warnings;
 
+use List::MoreUtils ();
 use Scalar::Util qw( looks_like_number );
 
 our $VERSION = '1.17';
@@ -58,6 +59,24 @@ sub _inline_check_arguments {
 
 sub _adds_members { 1 }
 
+# We need to override this because while @_ can be written to, we cannot write
+# directly to $_[1].
+around _inline_coerce_new_values => sub {
+    shift;
+    my $self = shift;
+
+    return q{} unless $self->associated_attribute->should_coerce;
+
+    return q{} unless $self->_tc_member_type_can_coerce;
+
+    # Is there a simpler way to do this?
+    return 'my $iter = List::MoreUtils::natatime 2, @_;'
+         .  '@_ = ();'
+         . 'while ( my ( $key, $val ) = $iter->() ) {'
+         .     'push @_, $key, $member_tc_obj->coerce($val);'
+         . '}';
+};
+
 sub _potential_value {
     my ( $self, $slot_access ) = @_;