Keep track of the source package of each type; other cleanups

diff --git a/Changes b/Changes
index 5501709..85276c3 100644 (file)
--- a/Changes
+++ b/Changes
@@ -7,6 +7,8 @@ Revision history for Mouse
 
     * "type" sugar for when you're not subtyping anything
 
+    * Keep track of the source package of each type
+
 0.14 Sat Dec 20 16:53:05 2008
     * POD fix
 

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index b7f39fc..732797f 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -6,6 +6,7 @@ use Carp ();
 use Scalar::Util qw/blessed looks_like_number openhandle/;
 
 my %TYPE;
+my %TYPE_SOURCE;
 my %COERCE;
 my %COERCE_KEYS;
 
@@ -82,30 +83,37 @@ my $optimized_constraints_base;
     sub optimized_constraints { \%TYPE }
     my @TYPE_KEYS = keys %TYPE;
     sub list_all_builtin_type_constraints { @TYPE_KEYS }
+
+    @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
 }
 
 sub _type {
     my $pkg = caller(0);
     my($name, %conf) = @_;
     if (my $type = $TYPE{$name}) {
-        Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg";
+        Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
-    my $stuff = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
-    $TYPE{$name} = $stuff;
+    my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
+
+    $TYPE_SOURCE{$name} = $pkg;
+    $TYPE{$name} = $constraint;
 }
 
 sub _subtype {
     my $pkg = caller(0);
     my($name, %conf) = @_;
     if (my $type = $TYPE{$name}) {
-        Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg";
+        Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
-    my $stuff = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
-    my $as    = $conf{as} || '';
+    my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
+    my $as         = $conf{as} || '';
+
+    $TYPE_SOURCE{$name} = $pkg;
+
     if ($as = $TYPE{$as}) {
-        $TYPE{$name} = sub { $as->($_) && $stuff->($_) };
+        $TYPE{$name} = sub { $as->($_) && $constraint->($_) };
     } else {
-        $TYPE{$name} = $stuff;
+        $TYPE{$name} = $constraint;
     }
 }
 

diff --git a/t/800_shikabased/002-coerce_multi_class.t b/t/800_shikabased/002-coerce_multi_class.t
index db5a8a7..4fb0128 100644 (file)
--- a/t/800_shikabased/002-coerce_multi_class.t
+++ b/t/800_shikabased/002-coerce_multi_class.t
@@ -38,7 +38,7 @@ eval {
 
     type 'Headers' => where { defined $_ && eval { $_->isa('Request::Headers') } };
 };
-like $@, qr/The type constraint 'Headers' has already been created, cannot be created again in Request/;
+like $@, qr/The type constraint 'Headers' has already been created in Response and cannot be created again in Request/;
 
 eval {
     package Request;
@@ -92,7 +92,7 @@ eval {
     package Response;
     type 'Headers' => where { defined $_ && eval { $_->isa('Response::Headers') } };
 };
-like $@, qr/The type constraint 'Headers' has already been created, cannot be created again in Response/;
+like $@, qr/The type constraint 'Headers' has already been created in Response and cannot be created again in Response/;
 
 {
     package Request;

diff --git a/t/800_shikabased/009-overwrite-builtin-subtype.t b/t/800_shikabased/009-overwrite-builtin-subtype.t
index d927a3f..ce8a996 100644 (file)
--- a/t/800_shikabased/009-overwrite-builtin-subtype.t
+++ b/t/800_shikabased/009-overwrite-builtin-subtype.t
@@ -8,4 +8,4 @@ eval {
 
     type 'Int' => where { 1};
 };
-like $@, qr/The type constraint 'Int' has already been created, cannot be created again in Request/;
+like $@, qr/The type constraint 'Int' has already been created in Mouse::Util::TypeConstraints and cannot be created again in Request/;