fixed
Stevan Little [Fri, 24 Mar 2006 19:55:06 +0000 (19:55 +0000)]
MANIFEST
lib/Moose/Util/TypeConstraints.pm
t/055_util_type_reloading.t [new file with mode: 0644]
t/lib/Bar.pm [new file with mode: 0644]

index d90b814..f37c89b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -29,6 +29,8 @@ t/051_util_type_constraints_export.t
 t/052_util_std_type_constraints.t
 t/053_util_find_type_constraint.t
 t/054_util_type_coercion.t
+t/055_util_type_reloading.t
 t/lib/Foo.pm
+t/lib/Bar.pm
 t/pod.t
 t/pod_coverage.t
index 2179e45..c8bbe76 100644 (file)
@@ -24,26 +24,27 @@ sub import {
 
 {
     my %TYPES;
-    sub find_type_constraint { $TYPES{$_[0]} }
+    sub find_type_constraint { $TYPES{$_[0]}->[1] }
 
     sub _create_type_constraint { 
         my ($name, $parent, $check) = @_;
-        (!exists $TYPES{$name})
+        my $pkg_defined_in = scalar(caller(1));
+        ($TYPES{$name}->[0] eq $pkg_defined_in)
             || confess "The type constraint '$name' has already been created"
-                if defined $name;
-        $parent = $TYPES{$parent} if defined $parent;
+                 if defined $name && exists $TYPES{$name};                
+        $parent = find_type_constraint($parent) if defined $parent;
         my $constraint = Moose::Meta::TypeConstraint->new(
             name       => $name || '__ANON__',
             parent     => $parent,            
             constraint => $check,           
         );
-        $TYPES{$name} = $constraint if defined $name;
+        $TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name;
         return $constraint;
     }
 
     sub _install_type_coercions { 
         my ($type_name, $coercion_map) = @_;
-        my $type = $TYPES{$type_name};
+        my $type = find_type_constraint($type_name);
         (!$type->has_coercion)
             || confess "The type coercion for '$type_name' has already been registered";        
         my $type_coercion = Moose::Meta::TypeCoercion->new(
@@ -57,7 +58,7 @@ sub import {
         my $pkg = caller();
            no strict 'refs';
        foreach my $constraint (keys %TYPES) {
-               *{"${pkg}::${constraint}"} = $TYPES{$constraint}->_compiled_type_constraint;
+               *{"${pkg}::${constraint}"} = find_type_constraint($constraint)->_compiled_type_constraint;
        }        
     }    
 }
diff --git a/t/055_util_type_reloading.t b/t/055_util_type_reloading.t
new file mode 100644 (file)
index 0000000..4956de6
--- /dev/null
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib', 'lib';
+
+use Test::More tests => 5;
+use Test::Exception;
+
+BEGIN {
+       use_ok('Moose');
+}
+
+eval { require Foo; };
+ok(!$@, '... loaded Foo successfully') || diag $@;
+
+delete $INC{'Foo.pm'};
+
+eval { require Foo; };
+ok(!$@, '... re-loaded Foo successfully') || diag $@;
+
+eval { require Bar; };
+ok(!$@, '... loaded Bar successfully') || diag $@;
+
+delete $INC{'Bar.pm'};
+
+eval { require Bar; };
+ok(!$@, '... re-loaded Bar successfully') || diag $@;
\ No newline at end of file
diff --git a/t/lib/Bar.pm b/t/lib/Bar.pm
new file mode 100644 (file)
index 0000000..e598f1f
--- /dev/null
@@ -0,0 +1,11 @@
+
+package Bar;
+use strict;
+use warnings;
+use Moose;
+
+type Baz => where { 1 };
+
+subtype Bling => as Baz => where { 1 };
+
+1;
\ No newline at end of file