convert all uses of Test::Exception to Test::Fatal.
[gitmo/Class-MOP.git] / t / 046_rebless_instance.t
CommitLineData
3d9e4646 1use strict;
2use warnings;
3
86a4d873 4use Test::More;
13b8971f 5use Test::Fatal;
3d9e4646 6use Scalar::Util 'blessed';
7
8{
9 package Parent;
10 use metaclass;
11
12 sub new { bless {} => shift }
13 sub whoami { "parent" }
14 sub parent { "parent" }
15
16 package Child;
17 use metaclass;
18 use base qw/Parent/;
19
20 sub whoami { "child" }
21 sub child { "child" }
22
23 package LeftField;
24 use metaclass;
25
26 sub new { bless {} => shift }
27 sub whoami { "leftfield" }
28 sub myhax { "areleet" }
29}
30
31# basic tests
32my $foo = Parent->new;
33is(blessed($foo), 'Parent', 'Parent->new gives a Parent');
34is($foo->whoami, "parent", 'Parent->whoami gives parent');
35is($foo->parent, "parent", 'Parent->parent gives parent');
13b8971f 36ok exception { $foo->child }, "Parent->child method doesn't exist";
3d9e4646 37
3cd40f5e 38Child->meta->rebless_instance($foo);
3d9e4646 39is(blessed($foo), 'Child', 'rebless_instance really reblessed the instance');
40is($foo->whoami, "child", 'reblessed->whoami gives child');
41is($foo->parent, "parent", 'reblessed->parent gives parent');
42is($foo->child, "child", 'reblessed->child gives child');
43
13b8971f 44like exception { LeftField->meta->rebless_instance($foo) },
de0d4f93 45 qr/You may rebless only into a subclass of \(Child\), of which \(LeftField\) isn't\./;
3cd40f5e 46
13b8971f 47like exception { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) },
de0d4f93 48 qr/You may rebless only into a subclass of \(Child\), of which \(NonExistent\) isn't\./;
3d9e4646 49
0708313d 50Parent->meta->rebless_instance_back($foo);
51is(blessed($foo), 'Parent', 'Parent->new gives a Parent');
52is($foo->whoami, "parent", 'Parent->whoami gives parent');
53is($foo->parent, "parent", 'Parent->parent gives parent');
13b8971f 54ok exception { $foo->child }, "Parent->child method doesn't exist";
0708313d 55
13b8971f 56like exception { LeftField->meta->rebless_instance_back($foo) },
0708313d 57 qr/You may rebless only into a superclass of \(Parent\), of which \(LeftField\) isn't\./;
58
13b8971f 59like exception { Class::MOP::Class->initialize("NonExistent")->rebless_instance_back($foo) },
0708313d 60 qr/You may rebless only into a superclass of \(Parent\), of which \(NonExistent\) isn't\./;
61
3d9e4646 62# make sure our ->meta is still sane
63my $bar = Parent->new;
64is(blessed($bar), 'Parent', "sanity check");
65is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
66is($bar->meta->name, 'Parent', "this Class::MOP::Class instance is for Parent");
67
68ok($bar->meta->has_method('new'), 'metaclass has "new" method');
69ok($bar->meta->has_method('whoami'), 'metaclass has "whoami" method');
70ok($bar->meta->has_method('parent'), 'metaclass has "parent" method');
71
72is(blessed($bar->meta->new_object), 'Parent', 'new_object gives a Parent');
73
3cd40f5e 74Child->meta->rebless_instance($bar);
3d9e4646 75is(blessed($bar), 'Child', "rebless really reblessed");
76is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
77is($bar->meta->name, 'Child', "this Class::MOP::Class instance is for Child");
78
79ok($bar->meta->find_method_by_name('new'), 'metaclass has "new" method');
80ok($bar->meta->find_method_by_name('parent'), 'metaclass has "parent" method');
81ok(!$bar->meta->has_method('new'), 'no "new" method in this class');
82ok(!$bar->meta->has_method('parent'), 'no "parent" method in this class');
83ok($bar->meta->has_method('whoami'), 'metaclass has "whoami" method');
84ok($bar->meta->has_method('child'), 'metaclass has "child" method');
85
86is(blessed($bar->meta->new_object), 'Child', 'new_object gives a Child');
87
0708313d 88Parent->meta->rebless_instance_back($bar);
89is(blessed($bar), 'Parent', "sanity check");
90is(blessed($bar->meta), 'Class::MOP::Class', "meta gives a Class::MOP::Class");
91is($bar->meta->name, 'Parent', "this Class::MOP::Class instance is for Parent");
92
93ok($bar->meta->has_method('new'), 'metaclass has "new" method');
94ok($bar->meta->has_method('whoami'), 'metaclass has "whoami" method');
95ok($bar->meta->has_method('parent'), 'metaclass has "parent" method');
96
97is(blessed($bar->meta->new_object), 'Parent', 'new_object gives a Parent');
98
86a4d873 99done_testing;