t/010_basics/014_create_anon.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use 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 }
  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
  87 done_testing;