From: Stevan Little Date: Fri, 24 Mar 2006 19:55:06 +0000 (+0000) Subject: fixed X-Git-Tag: 0_05~62 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0e6614c3d17bf87f8ec6284365bdd1f9295431b6;p=gitmo%2FMoose.git fixed --- diff --git a/MANIFEST b/MANIFEST index d90b814..f37c89b 100644 --- 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 diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 2179e45..c8bbe76 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -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 index 0000000..4956de6 --- /dev/null +++ b/t/055_util_type_reloading.t @@ -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 index 0000000..e598f1f --- /dev/null +++ b/t/lib/Bar.pm @@ -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