Fix issues on 5.6.2
gfx [Sat, 3 Oct 2009 07:41:11 +0000 (16:41 +0900)]
Changes
lib/Mouse/Meta/Attribute.pm
lib/Mouse/Meta/Method/Accessor.pm
lib/Mouse/Meta/Method/Constructor.pm
lib/Mouse/Meta/Method/Destructor.pm
t/020_attributes/016_attribute_traits_registered.t

diff --git a/Changes b/Changes
index a023856..2570d12 100644 (file)
--- 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()
 
index 9bc6e30..1946c96 100644 (file)
@@ -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,
index 621a259..cdc2bd4 100755 (executable)
@@ -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{
index 5ecbf90..1211e61 100644 (file)
@@ -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 {
index c3d2a0d..681cfaa 100644 (file)
@@ -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;
 }
 
index 91dc88a..b9e57d4 100755 (executable)
@@ -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';