From: Dave Rolsky <autarch@urth.org>
Date: Sat, 1 Nov 2008 19:29:48 +0000 (+0000)
Subject: Moose::Meta::Class->get_method_map was both broken and completely
X-Git-Tag: 0.61~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=96245b5a81c1e26b52133a282b31759d162ee635;p=gitmo%2FMoose.git

Moose::Meta::Class->get_method_map was both broken and completely
unnecessary. At one point, it might've done something different from
CMOP::Class for roles, but that was no longer the case.

This fixes a bug where some method objects would not have
->associated_metaclass set when they were returned.
---

diff --git a/Changes b/Changes
index af52925..0a2c10b 100644
--- a/Changes
+++ b/Changes
@@ -1,9 +1,18 @@
 Revision history for Perl extension Moose
-0.61 ???
+
+0.61
     * Moose::Meta::Attribute
       - When passing a role to handles, it will be loaded if necessary
         (perigrin)
 
+    * Moose::Meta::Class
+      - Method objects returned by get_method (and other methods)
+        Could end up being returned without an associated_metaclass
+        attribute. Removing get_method_map, which is provided by
+        Class::MOP::Class, fixed this. The Moose version did nothing
+        different from its parent except introduce a bug. (Dave ROlsky
+        - added tests for this (jdv79)
+
 0.60 Fri October 24, 2008
     * Moose::Exporter
       - Passing "-traits" when loading Moose caused the Moose.pm
diff --git a/MANIFEST b/MANIFEST
index 26b7626..61ce0ea 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -115,6 +115,7 @@ t/010_basics/014_create_anon.t
 t/010_basics/015_buildargs.t
 t/010_basics/016_load_into_main.t
 t/010_basics/017_error_handling.t
+t/010_basics/018_methods.t
 t/020_attributes/001_attribute_reader_generation.t
 t/020_attributes/002_attribute_writer_generation.t
 t/020_attributes/003_attribute_accessor_generation.t
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 97ef77d..bdb2c5e 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -195,60 +195,6 @@ sub construct_instance {
     return $instance;
 }
 
-# FIXME:
-# This is ugly
-sub get_method_map {
-    my $self = shift;
-
-    my $current = Class::MOP::check_package_cache_flag($self->name);
-
-    if (defined $self->{'_package_cache_flag'} && $self->{'_package_cache_flag'} == $current) {
-        return $self->{'methods'};
-    }
-
-    $self->{_package_cache_flag} = $current;
-
-    my $map  = $self->{'methods'};
-
-    my $class_name       = $self->name;
-    my $method_metaclass = $self->method_metaclass;
-
-    my %all_code = $self->get_all_package_symbols('CODE');
-
-    foreach my $symbol (keys %all_code) {
-        my $code = $all_code{$symbol};
-
-        next if exists  $map->{$symbol} &&
-                defined $map->{$symbol} &&
-                        $map->{$symbol}->body == $code;
-
-        my ($pkg, $name) = Class::MOP::get_code_info($code);
-
-        # NOTE:
-        # in 5.10 constant.pm the constants show up
-        # as being in the right package, but in pre-5.10
-        # they show up as constant::__ANON__ so we
-        # make an exception here to be sure that things
-        # work as expected in both.
-        # - SL
-        unless ( $pkg eq 'constant' && $name eq '__ANON__' ) {
-            next
-                if ( $pkg || '' ) ne $class_name
-                || ( ( $name || '' ) ne '__ANON__'
-                     && ( $pkg || '' ) ne $class_name
-                   );
-        }
-
-        $map->{$symbol} = $method_metaclass->wrap(
-            $code,
-            package_name => $class_name,
-            name         => $symbol
-        );
-    }
-
-    return $map;
-}
-
 ### ---------------------------------------------
 
 sub add_attribute {
diff --git a/t/010_basics/018_methods.t b/t/010_basics/018_methods.t
new file mode 100644
index 0000000..ce202cc
--- /dev/null
+++ b/t/010_basics/018_methods.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+
+my $test1 = Moose::Meta::Class->create_anon_class;
+$test1->add_method( 'foo1', sub { } );
+
+my $t1    = $test1->new_object;
+my $t1_am = $t1->meta->get_method('foo1')->associated_metaclass;
+ok( $t1_am, 'associated_metaclass is defined' );
+isa_ok(
+    $t1_am, 'Moose::Meta::Class',
+    'associated_metaclass is correct class'
+);
+
+{
+
+    package Test2;
+
+    use Moose;
+
+    sub foo2 { }
+}
+
+my $t2    = Test2->new;
+my $t2_am = $t2->meta->get_method('foo2')->associated_metaclass;
+ok( $t2_am, 'associated_metaclass is defined' );
+
+isa_ok(
+    $t2_am, 'Moose::Meta::Class',
+    'associated_metaclass is correct class'
+);