Commit | Line | Data |
587aca23 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
8a402c9e |
6 | use Test::More tests => 24; |
587aca23 |
7 | use Test::Exception; |
8 | |
9 | BEGIN { |
10 | use_ok('Class::MOP'); |
11 | } |
12 | |
6b96f5ab |
13 | { |
14 | package Foo; |
15 | use strict; |
16 | use warnings; |
17 | use metaclass; |
18 | |
19 | sub bar { 'Foo::bar' } |
20 | } |
21 | |
40483095 |
22 | my $anon_class_id; |
8a402c9e |
23 | my $instance; |
40483095 |
24 | { |
25 | my $anon_class = Class::MOP::Class->create_anon_class(); |
26 | isa_ok($anon_class, 'Class::MOP::Class'); |
27 | |
28 | ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/); |
29 | |
30 | ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists'); |
40483095 |
31 | like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name'); |
32 | |
6b96f5ab |
33 | is_deeply( |
34 | [$anon_class->superclasses], |
35 | [], |
36 | '... got an empty superclass list'); |
37 | lives_ok { |
38 | $anon_class->superclasses('Foo'); |
39 | } '... can add a superclass to anon class'; |
40 | is_deeply( |
41 | [$anon_class->superclasses], |
42 | [ 'Foo' ], |
43 | '... got the right superclass list'); |
44 | |
45 | ok(!$anon_class->has_method('foo'), '... no foo method'); |
40483095 |
46 | lives_ok { |
47 | $anon_class->add_method('foo' => sub { "__ANON__::foo" }); |
48 | } '... added a method to my anon-class'; |
8a402c9e |
49 | ok($anon_class->has_method('foo'), '... we have a foo method now'); |
40483095 |
50 | |
8a402c9e |
51 | $instance = $anon_class->new_object(); |
40483095 |
52 | isa_ok($instance, $anon_class->name); |
6b96f5ab |
53 | isa_ok($instance, 'Foo'); |
40483095 |
54 | |
55 | is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); |
6b96f5ab |
56 | is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); |
40483095 |
57 | } |
587aca23 |
58 | |
40483095 |
59 | ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists'); |
587aca23 |
60 | |
8a402c9e |
61 | # the superclass relationship actually |
62 | # still exists for the instance ... |
63 | isa_ok($instance, 'Foo'); |
64 | |
65 | # and oddly enough we can still |
66 | # call methods on our instance |
67 | can_ok($instance, 'foo'); |
68 | can_ok($instance, 'bar'); |
69 | |
70 | is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); |
71 | is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); |
72 | |
73 | # but it breaks down when we try to create another one ... |
74 | |
75 | my $instance_2 = bless {} => ref($instance); |
76 | isa_ok($instance_2, ref($instance)); |
77 | ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo'); |
78 | ok(!$instance_2->can('foo'), '... and it can no longer call the foo method'); |
79 | |
587aca23 |
80 | # NOTE: |
81 | # I bumped this test up to 100_000 instances, and |
82 | # still got not conflicts. If your application needs |
83 | # more than that, your probably mst |
84 | |
85 | my %conflicts; |
6b96f5ab |
86 | foreach my $i (1 .. 100) { |
587aca23 |
87 | $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef; |
88 | } |
6b96f5ab |
89 | is(scalar(keys %conflicts), 100, '... got as many classes as I would expect'); |
587aca23 |
90 | |