6 use Scalar::Util 'blessed';
12 sub new { bless {} => shift }
13 sub whoami { "parent" }
14 sub parent { "parent" }
20 sub whoami { "child" }
26 sub new { bless {} => shift }
27 sub whoami { "leftfield" }
28 sub myhax { "areleet" }
32 my $foo = Parent->new;
33 is(blessed($foo), 'Parent', 'Parent->new gives a Parent');
34 is($foo->whoami, "parent", 'Parent->whoami gives parent');
35 is($foo->parent, "parent", 'Parent->parent gives parent');
36 dies_ok { $foo->child } "Parent->child method doesn't exist";
38 Child->meta->rebless_instance($foo);
39 is(blessed($foo), 'Child', 'rebless_instance really reblessed the instance');
40 is($foo->whoami, "child", 'reblessed->whoami gives child');
41 is($foo->parent, "parent", 'reblessed->parent gives parent');
42 is($foo->child, "child", 'reblessed->child gives child');
44 throws_ok { LeftField->meta->rebless_instance($foo) }
45 qr/You may rebless only into a subclass of \(Child\), of which \(LeftField\) isn't\./;
47 throws_ok { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) }
48 qr/You may rebless only into a subclass of \(Child\), of which \(NonExistent\) isn't\./;
50 Parent->meta->rebless_instance_back($foo);
51 is(blessed($foo), 'Parent', 'Parent->new gives a Parent');
52 is($foo->whoami, "parent", 'Parent->whoami gives parent');
53 is($foo->parent, "parent", 'Parent->parent gives parent');
54 dies_ok { $foo->child } "Parent->child method doesn't exist";
56 throws_ok { LeftField->meta->rebless_instance_back($foo) }
57 qr/You may rebless only into a superclass of \(Parent\), of which \(LeftField\) isn't\./;
59 throws_ok { Class::MOP::Class->initialize("NonExistent")->rebless_instance_back($foo) }
60 qr/You may rebless only into a superclass of \(Parent\), of which \(NonExistent\) isn't\./;
62 # make sure our ->meta is still sane
63 my $bar = Parent->new;
64 is(blessed($bar), 'Parent', "sanity check");
65 is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
66 is($bar->meta->name, 'Parent', "this Class::MOP::Class instance is for Parent");
68 ok($bar->meta->has_method('new'), 'metaclass has "new" method');
69 ok($bar->meta->has_method('whoami'), 'metaclass has "whoami" method');
70 ok($bar->meta->has_method('parent'), 'metaclass has "parent" method');
72 is(blessed($bar->meta->new_object), 'Parent', 'new_object gives a Parent');
74 Child->meta->rebless_instance($bar);
75 is(blessed($bar), 'Child', "rebless really reblessed");
76 is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
77 is($bar->meta->name, 'Child', "this Class::MOP::Class instance is for Child");
79 ok($bar->meta->find_method_by_name('new'), 'metaclass has "new" method');
80 ok($bar->meta->find_method_by_name('parent'), 'metaclass has "parent" method');
81 ok(!$bar->meta->has_method('new'), 'no "new" method in this class');
82 ok(!$bar->meta->has_method('parent'), 'no "parent" method in this class');
83 ok($bar->meta->has_method('whoami'), 'metaclass has "whoami" method');
84 ok($bar->meta->has_method('child'), 'metaclass has "child" method');
86 is(blessed($bar->meta->new_object), 'Child', 'new_object gives a Child');
88 Parent->meta->rebless_instance_back($bar);
89 is(blessed($bar), 'Parent', "sanity check");
90 is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
91 is($bar->meta->name, 'Parent', "this Class::MOP::Class instance is for Parent");
93 ok($bar->meta->has_method('new'), 'metaclass has "new" method');
94 ok($bar->meta->has_method('whoami'), 'metaclass has "whoami" method');
95 ok($bar->meta->has_method('parent'), 'metaclass has "parent" method');
97 is(blessed($bar->meta->new_object), 'Parent', 'new_object gives a Parent');