summaryrefslogtreecommitdiff
path: root/t/basics/create_anon.t
blob: b36b2a809c02f048f2d3a8db0622fca8e2142cc1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
use strict;
use warnings;

use Test::More;

use Moose::Meta::Class;

{
    package Class;
    use Moose;

    package Foo;
    use Moose::Role;
    sub foo_role_applied { 1 }

    package Bar;
    use Moose::Role;
    sub bar_role_applied { 1 }
}

# try without caching first

{
    my $class_and_foo_1 = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        roles        => ['Foo'],
    );

    my $class_and_foo_2 = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        roles        => ['Foo'],
    );

    isnt $class_and_foo_1->name, $class_and_foo_2->name,
      'creating the same class twice without caching results in 2 classes';

    map { ok $_->name->foo_role_applied } ($class_and_foo_1, $class_and_foo_2);
}

# now try with caching

{
    my $class_and_foo_1 = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        roles        => ['Foo'],
        cache        => 1,
    );

    my $class_and_foo_2 = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        roles        => ['Foo'],
        cache        => 1,
    );

    is $class_and_foo_1->name, $class_and_foo_2->name,
      'with cache, the same class is the same class';

    map { ok $_->name->foo_role_applied } ($class_and_foo_1, $class_and_foo_2);

    my $class_and_bar = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        roles        => ['Bar'],
        cache        => 1,
    );

    isnt $class_and_foo_1->name, $class_and_bar,
      'class_and_foo and class_and_bar are different';

    ok $class_and_bar->name->bar_role_applied;
}

# This tests that a cached metaclass can be reinitialized and still retain its
# metaclass object.
{
    my $name = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        cache        => 1,
    )->name;

    $name->meta->reinitialize( $name );

    can_ok( $name, 'meta' );
}

{
    my $name;
    {
        my $meta = Moose::Meta::Class->create_anon_class(
            superclasses => ['Class'],
            cache        => 1,
        );
        $name = $meta->name;
        ok(!Class::MOP::metaclass_is_weak($name), "cache implies weaken => 0");
    }
    ok(Class::MOP::class_of($name), "cache implies weaken => 0");
    Class::MOP::remove_metaclass_by_name($name);
}

{
    my $name;
    {
        my $meta = Moose::Meta::Class->create_anon_class(
            superclasses => ['Class'],
            cache        => 1,
            weaken       => 1,
        );
        my $name = $meta->name;
        ok(Class::MOP::metaclass_is_weak($name), "but we can override this");
    }
    ok(!Class::MOP::class_of($name), "but we can override this");
}

{
    my $meta = Moose::Meta::Class->create_anon_class(
        superclasses => ['Class'],
        cache        => 1,
    );
    ok(!Class::MOP::metaclass_is_weak($meta->name),
       "creates a nonweak metaclass");
    Scalar::Util::weaken($meta);
    Class::MOP::remove_metaclass_by_name($meta->name);
    ok(!$meta, "removing a cached anon class means it's actually gone");
}

done_testing;