From: Ricardo Signes <rjbs@cpan.org>
Date: Fri, 22 Oct 2010 23:56:15 +0000 (-0400)
Subject: provide an assert_coerce to "coerce or throw"
X-Git-Tag: 1.18~72
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bb6ac54a06ef6abfe6adcc32c3606535a0126a18;p=gitmo%2FMoose.git

provide an assert_coerce to "coerce or throw"
---

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index f194c3f..00a8a0f 100644
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -90,6 +90,25 @@ sub coerce {
     return $coercion->coerce(@_);
 }
 
+sub assert_coerce {
+    my $self = shift;
+
+    my $coercion = $self->coercion;
+
+    unless ($coercion) {
+        require Moose;
+        Moose->throw_error("Cannot coerce without a type coercion");
+    }
+
+    return $_[0] if $self->check($_[0]);
+
+    my $result = $coercion->coerce(@_);
+
+    $self->assert_valid($result);
+
+    return $result;
+}
+
 sub check {
     my ($self, @args) = @_;
     my $constraint_subref = $self->_compiled_type_constraint;
diff --git a/t/040_type_constraints/007_util_more_type_coercion.t b/t/040_type_constraints/007_util_more_type_coercion.t
index 766e4ec..c24d6bc 100644
--- a/t/040_type_constraints/007_util_more_type_coercion.t
+++ b/t/040_type_constraints/007_util_more_type_coercion.t
@@ -114,4 +114,21 @@ dies_ok {
     Engine->new(header => \(my $var));
 } '... dies correctly with bad params';
 
+{
+    my $tc = Moose::Util::TypeConstraints::find_type_constraint('HTTPHeader');
+    isa_ok($tc, 'Moose::Meta::TypeConstraint', 'HTTPHeader TC');
+
+    my $from_aref = $tc->assert_coerce([ 1, 2, 3 ]);
+    isa_ok($from_aref, 'HTTPHeader', 'assert_coerce from aref to HTTPHeader');
+    is_deeply($from_aref->array, [ 1, 2, 3 ], '...and has the right guts');
+
+    my $from_href = $tc->assert_coerce({ a => 1 });
+    isa_ok($from_href, 'HTTPHeader', 'assert_coerce from href to HTTPHeader');
+    is_deeply($from_href->hash, { a => 1 }, '...and has the right guts');
+
+    throws_ok { $tc->assert_coerce('total garbage') }
+      qr/Validation failed for .HTTPHeader./,
+      "assert_coerce throws if result is not acceptable";
+}
+
 done_testing;