From: gfx <gfuji@cpan.org>
Date: Sat, 19 Dec 2009 07:30:46 +0000 (+0900)
Subject: Fix an issue that anonymous type constraint can't be defined
X-Git-Tag: 0.45~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=4f24c5987ee735b348eeb03eb36074e3cd83cfd3

Fix an issue that anonymous type constraint can't be defined
---

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 1ccdae1..928ff93 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -99,9 +99,7 @@ sub _create_type{
     }
 
     if(!defined $name){
-        if(!defined($name = $args{name})){
-            $name = '__ANON__';
-        }
+        $name = $args{name};
     }
 
     $args{name} = $name;
@@ -110,16 +108,20 @@ sub _create_type{
         $parent = delete $args{as};
         if(!$parent){
             $parent = delete $args{name};
-            $name   = '__ANON__';
+            $name   = undef;
         }
     }
 
-    my $package_defined_in = $args{package_defined_in} ||= caller(1);
-
-    my $existing = $TYPE{$name};
-    if($existing && $existing->{package_defined_in} ne $package_defined_in){
-        confess("The type constraint '$name' has already been created in "
-              . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
+    if(defined $name){
+        my $package_defined_in = $args{package_defined_in} ||= caller(1);
+        my $existing = $TYPE{$name};
+        if($existing && $existing->{package_defined_in} ne $package_defined_in){
+            confess("The type constraint '$name' has already been created in "
+                  . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
+        }
+    }
+    else{
+        $args{name} = '__ANON__';
     }
 
     $args{constraint} = delete $args{where}        if exists $args{where};
@@ -133,7 +135,12 @@ sub _create_type{
         $constraint = Mouse::Meta::TypeConstraint->new(%args);
     }
 
-    return $TYPE{$name} = $constraint;
+    if(defined $name){
+        return $TYPE{$name} = $constraint;
+    }
+    else{
+        return $constraint;
+    }
 }
 
 sub type {
diff --git a/t/001_mouse/039-subtype.t b/t/001_mouse/039-subtype.t
index 50b7bf9..7142f2b 100644
--- a/t/001_mouse/039-subtype.t
+++ b/t/001_mouse/039-subtype.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 11;
+use Test::More tests => 14;
 use Test::Exception;
 
 use Mouse::Util::TypeConstraints;
@@ -24,8 +24,6 @@ do {
         is  => 'ro',
         isa => 'NonemptyStr',
     );
-
-
 };
 
 ok(My::Class->new(name => 'foo'));
@@ -48,3 +46,13 @@ lives_and{
     ok!$tc->check([]);
     ok!$tc->check(undef);
 };
+
+package Foo;
+use Mouse::Util::TypeConstraints;
+
+$st = subtype as 'Int', where{ $_ > 0 };
+
+::ok $st->is_a_type_of('Int');
+::ok $st->check(10);
+::ok!$st->check(0);
+