Mouse::Util::does_role() respects $thing->does() method
[gitmo/Mouse.git] / t / 010_basics / 014_create_anon.t
CommitLineData
60ad2cb7 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6475f69d 6use Test::More;
60ad2cb7 7
8use Mouse::Meta::Class;
9
10{
11 package Class;
12 use Mouse;
13
14 package Foo;
15 use Mouse::Role;
16 sub foo_role_applied { 1 }
17
18 package Bar;
19 use Mouse::Role;
20 sub bar_role_applied { 1 }
21}
22
23# try without caching first
24
25{
26 my $class_and_foo_1 = Mouse::Meta::Class->create_anon_class(
27 superclasses => ['Class'],
28 roles => ['Foo'],
29 );
30
31 my $class_and_foo_2 = Mouse::Meta::Class->create_anon_class(
32 superclasses => ['Class'],
33 roles => ['Foo'],
34 );
35
36 isnt $class_and_foo_1->name, $class_and_foo_2->name,
37 'creating the same class twice without caching results in 2 classes';
38
39 map { ok $_->name->foo_role_applied } ($class_and_foo_1, $class_and_foo_2);
40}
41
42# now try with caching
43
44{
45 my $class_and_foo_1 = Mouse::Meta::Class->create_anon_class(
46 superclasses => ['Class'],
47 roles => ['Foo'],
48 cache => 1,
49 );
50
51 my $class_and_foo_2 = Mouse::Meta::Class->create_anon_class(
52 superclasses => ['Class'],
53 roles => ['Foo'],
54 cache => 1,
55 );
56
57 is $class_and_foo_1->name, $class_and_foo_2->name,
58 'with cache, the same class is the same class';
59
60 map { ok $_->name->foo_role_applied } ($class_and_foo_1, $class_and_foo_2);
61
62 my $class_and_bar = Mouse::Meta::Class->create_anon_class(
63 superclasses => ['Class'],
64 roles => ['Bar'],
65 cache => 1,
66 );
67
68 isnt $class_and_foo_1->name, $class_and_bar,
69 'class_and_foo and class_and_bar are different';
70
71 ok $class_and_bar->name->bar_role_applied;
72}
6475f69d 73
74# This tests that a cached metaclass can be reinitialized and still retain its
75# metaclass object.
76{
77 my $name = Mouse::Meta::Class->create_anon_class(
78 superclasses => ['Class'],
79 cache => 1,
80 )->name;
81
82 $name->meta->reinitialize( $name );
83
84 can_ok( $name, 'meta' );
85}
86
87done_testing;