Commit | Line | Data |
587aca23 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6b96f5ab |
6 | use Test::More tests => 16; |
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; |
23 | { |
24 | my $anon_class = Class::MOP::Class->create_anon_class(); |
25 | isa_ok($anon_class, 'Class::MOP::Class'); |
26 | |
27 | ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/); |
28 | |
29 | ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists'); |
40483095 |
30 | like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name'); |
31 | |
6b96f5ab |
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'); |
40483095 |
45 | lives_ok { |
46 | $anon_class->add_method('foo' => sub { "__ANON__::foo" }); |
47 | } '... added a method to my anon-class'; |
6b96f5ab |
48 | ok($anon_class->has_method('foo'), '... we have a foo method now'); |
40483095 |
49 | |
50 | my $instance = $anon_class->new_object(); |
51 | isa_ok($instance, $anon_class->name); |
6b96f5ab |
52 | isa_ok($instance, 'Foo'); |
40483095 |
53 | |
54 | is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); |
6b96f5ab |
55 | is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); |
40483095 |
56 | } |
587aca23 |
57 | |
40483095 |
58 | ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists'); |
587aca23 |
59 | |
60 | # NOTE: |
61 | # I bumped this test up to 100_000 instances, and |
62 | # still got not conflicts. If your application needs |
63 | # more than that, your probably mst |
64 | |
65 | my %conflicts; |
6b96f5ab |
66 | foreach my $i (1 .. 100) { |
587aca23 |
67 | $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef; |
68 | } |
6b96f5ab |
69 | is(scalar(keys %conflicts), 100, '... got as many classes as I would expect'); |
587aca23 |
70 | |