From: Dave Rolsky <autarch@urth.org>
Date: Thu, 18 Sep 2008 15:05:00 +0000 (+0000)
Subject: Fixed a bug where an explicitly set constructor or destructor (and now
X-Git-Tag: 0.58~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8f05895e370956a770680e226e63ed1ce4f2fc5a;p=gitmo%2FMoose.git

Fixed a bug where an explicitly set constructor or destructor (and now
error) class would be lost if roles were applied to other metaclasses,
but not said class.
---

diff --git a/lib/Moose/Util/MetaRole.pm b/lib/Moose/Util/MetaRole.pm
index 4724da7..2beb525 100644
--- a/lib/Moose/Util/MetaRole.pm
+++ b/lib/Moose/Util/MetaRole.pm
@@ -5,22 +5,29 @@ use warnings;
 
 use List::MoreUtils qw( all );
 
+my @Classes = qw( constructor_class destructor_class error_class );
+
 sub apply_metaclass_roles {
     my %options = @_;
 
     my $for = $options{for_class};
 
-    my $meta = _make_new_metaclass( $for, \%options );
+    my %old_classes = map { $_ => $for->meta->$_ } @Classes;
 
-    for my $tor_class ( grep { $options{ $_ . '_roles' } }
-        qw( constructor_class destructor_class ) ) {
+    my $meta = _make_new_metaclass( $for, \%options );
 
-        my $class = _make_new_class(
-            $meta->$tor_class(),
-            $options{ $tor_class . '_roles' }
-        );
+    for my $c (@Classes) {
+        if ( $options{ $c . '_roles' } ) {
+            my $class = _make_new_class(
+                $meta->$c(),
+                $options{ $c . '_roles' }
+            );
 
-        $meta->$tor_class($class);
+            $meta->$c($class);
+        }
+        else {
+            $meta->$c( $old_classes{$c} );
+        }
     }
 
     return $meta;
@@ -82,7 +89,7 @@ sub _make_new_class {
 
     return $existing_class unless $roles;
 
-    my $meta = $existing_class->meta();
+    my $meta = Class::MOP::Class->initialize($existing_class);
 
     return $existing_class
         if $meta->can('does_role') && all { $meta->does_role($_) } @{$roles};
diff --git a/t/050_metaclasses/015_metarole.t b/t/050_metaclasses/015_metarole.t
index 6d5d459..7353164 100644
--- a/t/050_metaclasses/015_metarole.t
+++ b/t/050_metaclasses/015_metarole.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 69;
+use Test::More tests => 71;
 
 use Moose::Util::MetaRole;
 
@@ -444,3 +444,29 @@ use Moose::Util::MetaRole;
     ok( My::Class10->meta()->isa('My::Meta::Class2'),
         q{... and My::Class10->meta still isa(My::Meta::Class2)} );
 }
+
+{
+    package My::Constructor;
+
+    use base 'Moose::Meta::Method::Constructor';
+}
+
+{
+    package My::Class11;
+
+    use Moose;
+
+    __PACKAGE__->meta->constructor_class('My::Constructor');
+
+    Moose::Util::MetaRole::apply_metaclass_roles(
+        for_class       => 'My::Class11',
+        metaclass_roles => ['Role::Foo'],
+    );
+}
+
+{
+    ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
+        q{My::Class11->meta()->meta() does Role::Foo } );
+    is( My::Class11->meta()->constructor_class, 'My::Constructor',
+        q{... and explicitly set constructor_class value is unchanged)} );
+}