From: Daisuke Maki (lestrrat) <daisuke@endeworks.jp>
Date: Tue, 10 Mar 2009 05:37:04 +0000 (+0900)
Subject: fix portability between Moose/Mouse's class_type
X-Git-Tag: 0.20~45
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d9f8c87830d51d04b6347e9ff52ddd6d04e09918;p=gitmo%2FMouse.git

fix portability between Moose/Mouse's class_type
---

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index d81d5d0..8b3841b 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -106,6 +106,7 @@ sub subtype {
     } else {
         $TYPE{$name} = sub { local $_=$_[0]; $constraint->($_) };
     }
+    return $name;
 }
 
 sub coerce {
@@ -137,12 +138,16 @@ sub coerce {
 }
 
 sub class_type {
-    my $pkg = caller(0);
     my($name, $conf) = @_;
-    my $class = $conf->{class};
-    subtype(
-        $name => where => sub { $_->isa($class) }
-    );
+    if ($conf && $conf->{class}) {
+        # No, you're using this wrong
+        warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
+        subtype($name, as => $conf->{class});
+    } else {
+        subtype(
+            $name => where => sub { $_->isa($name) }
+        );
+    }
 }
 
 sub role_type {
diff --git a/t/800_shikabased/005-class_type.t b/t/800_shikabased/005-class_type.t
index e58fde2..5b61762 100644
--- a/t/800_shikabased/005-class_type.t
+++ b/t/800_shikabased/005-class_type.t
@@ -8,7 +8,14 @@ use Test::More tests => 4;
 
     require t::lib::ClassType_Foo;
 
-    class_type Headers => { class => 't::lib::ClassType_Foo' };
+    # XXX: This below API is different from that of Moose.
+    # class_type() should be class_type 'ClassName';
+    #    class_type 'Headers' => { class => 't::lib::ClassType_Foo' };
+    # this should be subtype Headers => as 't::lib::ClassType_foo';
+    subtype 'Headers'
+        => as 't::lib::ClassType_Foo'
+    ;
+        
     coerce 'Headers' =>
         from 'HashRef' => via {
             t::lib::ClassType_Foo->new(%{ $_ });