From: 大沢 和宏 <yappo@shibuya.pl>
Date: Mon, 8 Dec 2008 04:05:46 +0000 (+0000)
Subject: oops, add testcase ( subtype 'Foo' => as 'Bar'; AND subtype 'Foo'; )
X-Git-Tag: 0.19~136^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=2f665925359d9fba8a49baeccd7ad798f733221d

oops, add testcase ( subtype 'Foo' => as 'Bar'; AND subtype 'Foo'; )
---

diff --git a/lib/Mouse/TypeRegistry.pm b/lib/Mouse/TypeRegistry.pm
index 458c810..055c1ac 100644
--- a/lib/Mouse/TypeRegistry.pm
+++ b/lib/Mouse/TypeRegistry.pm
@@ -92,8 +92,8 @@ sub _subtype {
     if (my $type = $SUBTYPE{$name}) {
         Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg";
     };
-    my $stuff = $conf{where};
-    my $as = $conf{as} || '';
+    my $stuff = $conf{where} || do { $SUBTYPE{delete $conf{as} || 'Any' } };
+    my $as    = $conf{as} || '';
     if ($as = $SUBTYPE{$as}) {
         $SUBTYPE{$name} = sub { $as->($_) && $stuff->($_) };
     } else {
diff --git a/t/800_shikabased/014-subtype-as.t b/t/800_shikabased/014-subtype-as.t
index cf9e40e..8ee8ef0 100644
--- a/t/800_shikabased/014-subtype-as.t
+++ b/t/800_shikabased/014-subtype-as.t
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 6;
+use Test::More tests => 12;
 use Scalar::Util qw/blessed/;
 
 {
@@ -29,6 +29,19 @@ use Scalar::Util qw/blessed/;
         is     => 'rw',
         isa    => 'Type2',
     );
+
+    subtype 'Type3' => as 'Object';
+    has as_only => (
+        is     => 'rw',
+        isa    => 'Type3',
+    );
+
+
+    subtype 'Type4';
+    has any => (
+        is     => 'rw',
+        isa    => 'Type4',
+    );
 }
 
 eval { Foo->new( str_obj => Obj1->new ) };
@@ -45,3 +58,15 @@ like $@, qr/Attribute \(str_obj\) does not pass the type constraint because: Val
 my $f1 = eval { Foo->new( obj_str => Obj2->new ) };
 isa_ok $f1, 'Foo';
 is $f1->obj_str, 'Ref';
+
+my $f2 = eval { Foo->new( as_only => Obj1->new ) };
+isa_ok $f2, 'Foo';
+is ref($f2->as_only), 'Obj1';
+
+my $f3 = eval { Foo->new( any => Obj1->new ) };
+isa_ok $f3, 'Foo';
+is ref($f3->any), 'Obj1';
+
+my $f4 = eval { Foo->new( any => 'YATTA' ) };
+isa_ok $f4, 'Foo';
+is $f4->any, 'YATTA';