[Moose-commits] r7154 - in Mouse/trunk: . lib/Mouse/Util t/800_shikabased

[sartak at code2.0beta.co.uk]

Author: sartak
Date: 2008-12-21 19:19:34 -0800 (Sun, 21 Dec 2008)
New Revision: 7154

Modified:
   Mouse/trunk/
   Mouse/trunk/Changes
   Mouse/trunk/lib/Mouse/Util/TypeConstraints.pm
   Mouse/trunk/t/800_shikabased/002-coerce_multi_class.t
   Mouse/trunk/t/800_shikabased/009-overwrite-builtin-subtype.t
Log:
 r77755 at onn:  sartak | 2008-12-21 22:19:22 -0500
 Keep track of the source package of each type; other cleanups



Property changes on: Mouse/trunk
___________________________________________________________________
Name: svk:merge
   - 08e7d58d-de06-4458-8c15-335e402ab116:/local/Mouse:77753
08e7d58d-de06-4458-8c15-335e402ab116:/local/Mouse-trunk:61565
3efe9002-19ed-0310-8735-a98156148065:/Mouse/branches/shika-based:6997
   + 08e7d58d-de06-4458-8c15-335e402ab116:/local/Mouse:77755
08e7d58d-de06-4458-8c15-335e402ab116:/local/Mouse-trunk:61565
3efe9002-19ed-0310-8735-a98156148065:/Mouse/branches/shika-based:6997

Modified: Mouse/trunk/Changes
===================================================================
--- Mouse/trunk/Changes	2008-12-22 03:10:10 UTC (rev 7153)
+++ Mouse/trunk/Changes	2008-12-22 03:19:34 UTC (rev 7154)
@@ -7,6 +7,8 @@
 
     * "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
 

Modified: Mouse/trunk/lib/Mouse/Util/TypeConstraints.pm
===================================================================
--- Mouse/trunk/lib/Mouse/Util/TypeConstraints.pm	2008-12-22 03:10:10 UTC (rev 7153)
+++ Mouse/trunk/lib/Mouse/Util/TypeConstraints.pm	2008-12-22 03:19:34 UTC (rev 7154)
@@ -6,6 +6,7 @@
 use Scalar::Util qw/blessed looks_like_number openhandle/;
 
 my %TYPE;
+my %TYPE_SOURCE;
 my %COERCE;
 my %COERCE_KEYS;
 
@@ -82,30 +83,37 @@
     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;
     }
 }
 

Modified: Mouse/trunk/t/800_shikabased/002-coerce_multi_class.t
===================================================================
--- Mouse/trunk/t/800_shikabased/002-coerce_multi_class.t	2008-12-22 03:10:10 UTC (rev 7153)
+++ Mouse/trunk/t/800_shikabased/002-coerce_multi_class.t	2008-12-22 03:19:34 UTC (rev 7154)
@@ -38,7 +38,7 @@
 
     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 @@
     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;

Modified: Mouse/trunk/t/800_shikabased/009-overwrite-builtin-subtype.t
===================================================================
--- Mouse/trunk/t/800_shikabased/009-overwrite-builtin-subtype.t	2008-12-22 03:10:10 UTC (rev 7153)
+++ Mouse/trunk/t/800_shikabased/009-overwrite-builtin-subtype.t	2008-12-22 03:19:34 UTC (rev 7154)
@@ -8,4 +8,4 @@
 
     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/;