Commit | Line | Data |
587aca23 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
efd3d14c |
6 | use Test::More tests => 18; |
587aca23 |
7 | use Test::Exception; |
8 | |
efd3d14c |
9 | use Class::MOP; |
587aca23 |
10 | |
6b96f5ab |
11 | { |
12 | package Foo; |
13 | use strict; |
14 | use warnings; |
15 | use metaclass; |
16 | |
17 | sub bar { 'Foo::bar' } |
18 | } |
19 | |
40483095 |
20 | my $anon_class_id; |
21 | { |
d4ba1677 |
22 | my $instance; |
23 | { |
24 | my $anon_class = Class::MOP::Class->create_anon_class(); |
25 | isa_ok($anon_class, 'Class::MOP::Class'); |
40483095 |
26 | |
d4ba1677 |
27 | ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/); |
40483095 |
28 | |
d4ba1677 |
29 | ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists'); |
30 | like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name'); |
31 | |
32 | is_deeply( |
33 | [$anon_class->superclasses], |
34 | [], |
35 | '... got an empty superclass list'); |
36 | lives_ok { |
37 | $anon_class->superclasses('Foo'); |
38 | } '... can add a superclass to anon class'; |
39 | is_deeply( |
40 | [$anon_class->superclasses], |
41 | [ 'Foo' ], |
42 | '... got the right superclass list'); |
43 | |
44 | ok(!$anon_class->has_method('foo'), '... no foo method'); |
45 | lives_ok { |
46 | $anon_class->add_method('foo' => sub { "__ANON__::foo" }); |
47 | } '... added a method to my anon-class'; |
48 | ok($anon_class->has_method('foo'), '... we have a foo method now'); |
49 | |
50 | $instance = $anon_class->new_object(); |
51 | isa_ok($instance, $anon_class->name); |
52 | isa_ok($instance, 'Foo'); |
53 | |
54 | is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); |
55 | is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); |
56 | } |
57 | |
58 | ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package still exists'); |
40483095 |
59 | } |
587aca23 |
60 | |
40483095 |
61 | ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists'); |
587aca23 |
62 | |
8a402c9e |
63 | # but it breaks down when we try to create another one ... |
64 | |
d4ba1677 |
65 | my $instance_2 = bless {} => ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id); |
66 | isa_ok($instance_2, ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id)); |
8a402c9e |
67 | ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo'); |
68 | ok(!$instance_2->can('foo'), '... and it can no longer call the foo method'); |
69 | |
587aca23 |
70 | |