Some simplifications to rebless given by stevan++
Shawn M Moore [Sun, 13 Jan 2008 02:55:19 +0000 (02:55 +0000)]
it's now NewClass->rebless_instance($instance)

lib/Class/MOP/Class.pm
t/046-rebless.t

index f22b07e..f0851a5 100644 (file)
@@ -394,35 +394,22 @@ sub clone_instance {
 }
 
 sub rebless_instance {
-    my ($self, $instance, $new_metaclass) = @_;
-
-    # it's okay (expected, even) to pass in a package name
-    unless (blessed $new_metaclass) {
-        $new_metaclass = $self->initialize($new_metaclass);
-    }
+    my ($self, $instance) = @_;
+    my $old_metaclass = $instance->meta();
     my $meta_instance = $self->get_meta_instance();
 
-    # make sure we're reblessing into a subclass
-    my $is_subclass = 0;
-    for my $superclass ($new_metaclass->linearized_isa) {
-        if ($superclass eq $self->name) {
-            $is_subclass = 1;
-            last;
-        }
-    }
-
-    $is_subclass
-        || confess "You may rebless only into a subclass. (". $new_metaclass->name .") is not a subclass of (". $self->name .").";
+    $self->name->isa($old_metaclass->name)
+        || confess "You may rebless only into a subclass. (". $self->name .") is not a subclass of (". $old_metaclass->name .").";
 
     # rebless!
-    $meta_instance->rebless_instance_structure($instance, $new_metaclass);
+    $meta_instance->rebless_instance_structure($instance, $self);
 
     # check and upgrade all attributes
     my %params = map { $_->name => $meta_instance->get_slot_value($instance, $_->name) }
                  grep { $meta_instance->is_slot_initialized($instance, $_->name) }
-                 $new_metaclass->compute_all_applicable_attributes;
+                 $self->compute_all_applicable_attributes;
 
-    foreach my $attr ($new_metaclass->compute_all_applicable_attributes) {
+    foreach my $attr ($self->compute_all_applicable_attributes) {
         $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }
 }
index ae5d1f3..a6baa40 100644 (file)
@@ -37,14 +37,17 @@ is($foo->whoami, "parent", 'Parent->whoami gives parent');
 is($foo->parent, "parent", 'Parent->parent gives parent');
 dies_ok { $foo->child } "Parent->child method doesn't exist";
 
-$foo->meta->rebless_instance($foo, "Child");
+Child->meta->rebless_instance($foo);
 is(blessed($foo), 'Child', 'rebless_instance really reblessed the instance');
 is($foo->whoami, "child", 'reblessed->whoami gives child');
 is($foo->parent, "parent", 'reblessed->parent gives parent');
 is($foo->child, "child", 'reblessed->child gives child');
 
-throws_ok { $foo->meta->rebless_instance($foo, "LeftField") } qr/You may rebless only into a subclass. \(LeftField\) is not a subclass of \(Child\)\./;
-throws_ok { $foo->meta->rebless_instance($foo, "NonExistent") } qr/You may rebless only into a subclass. \(NonExistent\) is not a subclass of \(Child\)\./;
+throws_ok { LeftField->meta->rebless_instance($foo, "LeftField") }
+          qr/You may rebless only into a subclass. \(LeftField\) is not a subclass of \(Child\)\./;
+
+throws_ok { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) }
+          qr/You may rebless only into a subclass. \(NonExistent\) is not a subclass of \(Child\)\./;
 
 # make sure our ->meta is still sane
 my $bar = Parent->new;
@@ -58,7 +61,7 @@ ok($bar->meta->has_method('parent'), 'metaclass has "parent" method');
 
 is(blessed($bar->meta->new_object), 'Parent', 'new_object gives a Parent');
 
-$bar->meta->rebless_instance($bar, "Child");
+Child->meta->rebless_instance($bar);
 is(blessed($bar), 'Child', "rebless really reblessed");
 is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
 is($bar->meta->name, 'Child', "this Class::MOP::Class instance is for Child");