From: gfx Date: Sat, 3 Oct 2009 07:41:11 +0000 (+0900) Subject: Fix issues on 5.6.2 X-Git-Tag: 0.37_02~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ad087d1140e1f90a85f2f47cc05bd648fb4ea38e;p=gitmo%2FMouse.git Fix issues on 5.6.2 --- diff --git a/Changes b/Changes index a023856..2570d12 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,6 @@ Revision history for Mouse -0.37_02 Sat Oct 3 15:57:15 2009 +0.37_02 * Mouse::Meta::Attribute - Add get_read_method_ref() and get_write_method_ref() diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 9bc6e30..1946c96 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -230,6 +230,7 @@ sub interpolate_class{ } if (@traits) { + warn "traits [@traits] for $class\n"; $class = Mouse::Meta::Class->create_anon_class( superclasses => [ $class ], roles => \@traits, diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm index 621a259..cdc2bd4 100755 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -24,7 +24,7 @@ sub _generate_accessor{ my $accessor = '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - sprintf("sub %s {\n", defined($method_name) ? $class->name . '::' . $method_name : ''); + "sub {\n"; if ($type eq 'accessor' || $type eq 'writer') { if($type eq 'accessor'){ @@ -126,7 +126,11 @@ sub _generate_accessor{ }; die $e if $e; - return $code; # returns a CODE ref unless $method_name is passed + if(defined $method_name){ + $class->add_method($method_name => $code); + } + + return $code; } sub _generate_reader{ diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 5ecbf90..1211e61 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -15,12 +15,10 @@ sub _generate_constructor_method { my @compiled_constraints = map { $_ ? $_->_compiled_type_constraint : undef } map { $_->type_constraint } @attrs; - my $constructor_name = defined($args->{constructor_name}) - ? $associated_metaclass_name . '::' . $args->{constructor_name} - : ''; - my $code = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; - sub $constructor_name \{ + + my $source = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; + sub \{ my \$class = shift; return \$class->Mouse::Object::new(\@_) if \$class ne q{$associated_metaclass_name}; @@ -32,10 +30,16 @@ sub _generate_constructor_method { } ... - local $@; - my $res = eval $code; - die $@ if $@; - $res; + my $code; + my $e = do{ + local $@; + $code = eval $source; + $@; + }; + die $e if $e; + + $metaclass->add_method($args->{constructor_name} => $code); + return; } sub _generate_processattrs { diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index c3d2a0d..681cfaa 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -24,7 +24,7 @@ sub _generate_destructor_method { }; my $destructor_name = $metaclass->name . '::DESTROY'; - my $code = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; + my $source = sprintf("#line %d %s\n", __LINE__, __FILE__) . <<"..."; sub $destructor_name \{ my \$self = shift; $demolishall; @@ -33,10 +33,10 @@ sub _generate_destructor_method { my $e = do{ local $@; - eval $code; + eval $source; $@; }; - die $@ if $@; + die $e if $e; return; } diff --git a/t/020_attributes/016_attribute_traits_registered.t b/t/020_attributes/016_attribute_traits_registered.t index 91dc88a..b9e57d4 100755 --- a/t/020_attributes/016_attribute_traits_registered.t +++ b/t/020_attributes/016_attribute_traits_registered.t @@ -5,13 +5,13 @@ use warnings; use Test::More tests => 23; use Test::Exception; -use Test::Moose; - +use lib 't/lib'; +use Test::Mouse; { package My::Attribute::Trait; - use Moose::Role; + use Mouse::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); @@ -25,13 +25,13 @@ use Test::Moose; ); }; - package Moose::Meta::Attribute::Custom::Trait::Aliased; + package Mouse::Meta::Attribute::Custom::Trait::Aliased; sub register_implementation { 'My::Attribute::Trait' } } { package My::Other::Attribute::Trait; - use Moose::Role; + use Mouse::Role; my $method = sub { 42; @@ -47,13 +47,13 @@ use Test::Moose; ); }; - package Moose::Meta::Attribute::Custom::Trait::Other; + package Mouse::Meta::Attribute::Custom::Trait::Other; sub register_implementation { 'My::Other::Attribute::Trait' } } { package My::Class; - use Moose; + use Mouse; has 'bar' => ( traits => [qw/Aliased/], @@ -65,7 +65,7 @@ use Test::Moose; { package My::Derived::Class; - use Moose; + use Mouse; extends 'My::Class';