X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F040_type_constraints%2F005_util_type_coercion.t;h=49f90690a76e956bcbd6f24de3fbd30117104f76;hb=53a4d826caec4b82f5b23e0bc0a4e8e2f44243b9;hp=4fb8c555ca162a696eca874044cfccc85af39d7f;hpb=d9b400059075f0cdffc909861da391aff5f7db66;p=gitmo%2FMoose.git

diff --git a/t/040_type_constraints/005_util_type_coercion.t b/t/040_type_constraints/005_util_type_coercion.t
index 4fb8c55..49f9069 100644
--- a/t/040_type_constraints/005_util_type_coercion.t
+++ b/t/040_type_constraints/005_util_type_coercion.t
@@ -3,48 +3,34 @@
 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More;
 use Test::Exception;
 
 BEGIN {
-	use_ok('Moose::Util::TypeConstraints');
+    use_ok('Moose::Util::TypeConstraints');
 }
 
 {
     package HTTPHeader;
     use Moose;
-    
+
     has 'array' => (is => 'ro');
-    has 'hash'  => (is => 'ro');    
+    has 'hash'  => (is => 'ro');
 }
 
-subtype Header => 
-    => as Object 
+subtype Header =>
+    => as Object
     => where { $_->isa('HTTPHeader') };
-    
-coerce Header 
-    => from ArrayRef 
+
+coerce Header
+    => from ArrayRef
         => via { HTTPHeader->new(array => $_[0]) }
-    => from HashRef 
+    => from HashRef
         => via { HTTPHeader->new(hash => $_[0]) };
 
 
-{
-	package Math::BigFloat;
-	sub new { bless { }, shift }; # not a moose class ;-)
-}
+Moose::Util::TypeConstraints->export_type_constraints_as_functions();
 
-subtype "Math::BigFloat"
-	=> as "Math::BigFloat"
-	=> where { 1 };
-
-coerce "Math::BigFloat"
-	=> from Num
-		=> via { Math::BigFloat->new( $_ ) };
-
-        
-Moose::Util::TypeConstraints->export_type_constraints_as_functions();        
-        
 my $header = HTTPHeader->new();
 isa_ok($header, 'HTTPHeader');
 
@@ -52,39 +38,67 @@ ok(Header($header), '... this passed the type test');
 ok(!Header([]), '... this did not pass the type test');
 ok(!Header({}), '... this did not pass the type test');
 
-my $coercion = find_type_constraint('Header')->coercion;
-isa_ok($coercion, 'Moose::Meta::TypeCoercion');
-
-{
-    my $coerced = $coercion->coerce([ 1, 2, 3 ]);
-    isa_ok($coerced, 'HTTPHeader');
-
-    is_deeply(
-        $coerced->array(),
-        [ 1, 2, 3 ],
-        '... got the right array');
-    is($coerced->hash(), undef, '... nothing assigned to the hash');        
+my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
+
+lives_ok {
+    coerce $anon_type
+        => from ArrayRef
+            => via { HTTPHeader->new(array => $_[0]) }
+        => from HashRef
+            => via { HTTPHeader->new(hash => $_[0]) };
+} 'coercion of anonymous subtype succeeds';
+
+foreach my $coercion (
+    find_type_constraint('Header')->coercion,
+    $anon_type->coercion
+    ) {
+
+    isa_ok($coercion, 'Moose::Meta::TypeCoercion');
+
+    {
+        my $coerced = $coercion->coerce([ 1, 2, 3 ]);
+        isa_ok($coerced, 'HTTPHeader');
+
+        is_deeply(
+            $coerced->array(),
+            [ 1, 2, 3 ],
+            '... got the right array');
+        is($coerced->hash(), undef, '... nothing assigned to the hash');
+    }
+
+    {
+        my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
+        isa_ok($coerced, 'HTTPHeader');
+
+        is_deeply(
+            $coerced->hash(),
+            { one => 1, two => 2, three => 3 },
+            '... got the right hash');
+        is($coerced->array(), undef, '... nothing assigned to the array');
+    }
+
+    {
+        my $scalar_ref = \(my $var);
+        my $coerced = $coercion->coerce($scalar_ref);
+        is($coerced, $scalar_ref, '... got back what we put in');
+    }
+
+    {
+        my $coerced = $coercion->coerce("Foo");
+        is($coerced, "Foo", '... got back what we put in');
+    }
 }
 
-{
-    my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
-    isa_ok($coerced, 'HTTPHeader');
-    
-    is_deeply(
-        $coerced->hash(),
-        { one => 1, two => 2, three => 3 },
-        '... got the right hash');
-    is($coerced->array(), undef, '... nothing assigned to the array');        
-}
+subtype 'StrWithTrailingX'
+    => as 'Str'
+    => where { /X$/ };
 
-{
-    my $scalar_ref = \(my $var);
-    my $coerced = $coercion->coerce($scalar_ref);
-    is($coerced, $scalar_ref, '... got back what we put in');
-}
+coerce 'StrWithTrailingX'
+    => from 'Str'
+    => via { $_ . 'X' };
 
-{
-    my $coerced = $coercion->coerce("Foo");
-    is($coerced, "Foo", '... got back what we put in');
-}
+my $tc = find_type_constraint('StrWithTrailingX');
+is($tc->coerce("foo"), "fooX", "coerce when needed");
+is($tc->coerce("fooX"), "fooX", "do not coerce when unneeded");
 
+done_testing;