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=e5719a51d40661dc4c5ca31bfa1978d1d9b19527;hp=e4a049275a54286388244554f8b785619c478fcf;hpb=844f32e85796e06d10903e6aea34672dfff8981b;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 e4a0492..49f9069 100644
--- a/t/040_type_constraints/005_util_type_coercion.t
+++ b/t/040_type_constraints/005_util_type_coercion.t
@@ -3,34 +3,34 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+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]) };
 
-        
-Moose::Util::TypeConstraints->export_type_constraints_as_functions();        
-        
+
+Moose::Util::TypeConstraints->export_type_constraints_as_functions();
+
 my $header = HTTPHeader->new();
 isa_ok($header, 'HTTPHeader');
 
@@ -42,9 +42,9 @@ my $anon_type = subtype Object => where { $_->isa('HTTPHeader') };
 
 lives_ok {
     coerce $anon_type
-        => from ArrayRef 
+        => from ArrayRef
             => via { HTTPHeader->new(array => $_[0]) }
-        => from HashRef 
+        => from HashRef
             => via { HTTPHeader->new(hash => $_[0]) };
 } 'coercion of anonymous subtype succeeds';
 
@@ -54,37 +54,51 @@ foreach my $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');        
+        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');        
+        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');
     }
 }
+
+subtype 'StrWithTrailingX'
+    => as 'Str'
+    => where { /X$/ };
+
+coerce 'StrWithTrailingX'
+    => from 'Str'
+    => via { $_ . 'X' };
+
+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;