From: Dave Rolsky <autarch@urth.org>
Date: Sun, 14 Sep 2008 21:04:16 +0000 (+0000)
Subject: Simply fix metaclass incompat before we check if it is compat.
X-Git-Tag: 0.58~34^2~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2b72f3b429b2a05600a0b6dc227c78b949b886a2;p=gitmo%2FMoose.git

Simply fix metaclass incompat before we check if it is compat.

This fixes various weird edge cases where a metaclass object is
created and is not compat with the parent's metaclass. In particular,
this fixes the case where a class applied traits to its metaclass, and
some other class subclasses it via "use base" and not extends.
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 2bfe0cc..31261a3 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -64,15 +64,8 @@ sub create {
         || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
             if exists $options{roles};
 
-    my $super = delete $options{superclasses};
-
     my $class = $self->SUPER::create($package_name, %options);
 
-    if ( my @super = @{ $super || [] } ) {
-        $class->_fix_metaclass_incompatibility(@super);
-        $class->superclasses(@super);
-    }
-
     if (exists $options{roles}) {
         Moose::Util::apply_all_roles($class, @{$options{roles}});
     }
@@ -80,6 +73,16 @@ sub create {
     return $class;
 }
 
+sub check_metaclass_compatibility {
+    my $self = shift;
+
+    if ( my @supers = $self->superclasses ) {
+        $self->_fix_metaclass_incompatibility(@supers);
+    }
+
+    $self->SUPER::check_metaclass_compatibility(@_);
+}
+
 my %ANON_CLASSES;
 
 sub create_anon_class {
@@ -541,7 +544,7 @@ sub _reconcile_role_differences {
         $roles{ $thing . '_roles' } = \@roles;
     }
 
-    $self = $self->_reinitialize_with($super_meta);
+    $self->_reinitialize_with($super_meta);
 
     Moose::Util::MetaRole::apply_metaclass_roles(
         for_class => $self->name,
diff --git a/t/050_metaclasses/017_use_base_of_moose.t b/t/050_metaclasses/017_use_base_of_moose.t
new file mode 100644
index 0000000..2fedbdc
--- /dev/null
+++ b/t/050_metaclasses/017_use_base_of_moose.t
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Exception;
+
+{
+    package NoOpTrait;
+    use Moose::Role;
+}
+
+{
+    package Parent;
+    use Moose -traits => 'NoOpTrait';
+
+    has attr => (
+        is  => 'rw',
+        isa => 'Str',
+    );
+}
+
+{
+    package Child;
+    use base 'Parent';
+}
+
+is(Child->meta->name, 'Child', "correct metaclass name");
+
+my $child = Child->new(attr => "ibute");
+ok($child, "constructor works");
+
+is($child->attr, "ibute", "getter inherited properly");
+
+$child->attr("ition");
+is($child->attr, "ition", "setter inherited properly");