From: Shawn M Moore Date: Sun, 13 Jan 2008 02:55:19 +0000 (+0000) Subject: Some simplifications to rebless given by stevan++ X-Git-Tag: 0_51~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3cd40f5e630dfe2d2e70b53530580556f86eceb5;p=gitmo%2FClass-MOP.git Some simplifications to rebless given by stevan++ it's now NewClass->rebless_instance($instance) --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index f22b07e..f0851a5 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -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); } } diff --git a/t/046-rebless.t b/t/046-rebless.t index ae5d1f3..a6baa40 100644 --- a/t/046-rebless.t +++ b/t/046-rebless.t @@ -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");