t/basics/create_anon.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Moose::Meta::Class;
   9
  10 {
  11     package Class;
  12     use Moose;
  13
  14     package Foo;
  15     use Moose::Role;
  16     sub foo_role_applied { 1 }
  17
  18     package Bar;
  19     use Moose::Role;
  20     sub bar_role_applied { 1 }
  21 }
  22
  23 # try without caching first
  24
  25 {
  26     my $class_and_foo_1 = Moose::Meta::Class->create_anon_class(
  27         superclasses => ['Class'],
  28         roles        => ['Foo'],
  29     );
  30
  31     my $class_and_foo_2 = Moose::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 = Moose::Meta::Class->create_anon_class(
  46         superclasses => ['Class'],
  47         roles        => ['Foo'],
  48         cache        => 1,
  49     );
  50
  51     my $class_and_foo_2 = Moose::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 = Moose::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 = Moose::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 {
  88     my $name;
  89     {
  90         my $meta = Moose::Meta::Class->create_anon_class(
  91             superclasses => ['Class'],
  92             cache        => 1,
  93         );
  94         $name = $meta->name;
  95         ok(!Class::MOP::metaclass_is_weak($name), "cache implies weaken => 0");
  96     }
  97     ok(Class::MOP::class_of($name), "cache implies weaken => 0");
  98     Class::MOP::remove_metaclass_by_name($name);
  99 }
 100
 101 {
 102     my $name;
 103     {
 104         my $meta = Moose::Meta::Class->create_anon_class(
 105             superclasses => ['Class'],
 106             cache        => 1,
 107             weaken       => 1,
 108         );
 109         my $name = $meta->name;
 110         ok(Class::MOP::metaclass_is_weak($name), "but we can override this");
 111     }
 112     ok(!Class::MOP::class_of($name), "but we can override this");
 113 }
 114
 115 {
 116     my $meta = Moose::Meta::Class->create_anon_class(
 117         superclasses => ['Class'],
 118         cache        => 1,
 119     );
 120     ok(!Class::MOP::metaclass_is_weak($meta->name),
 121        "creates a nonweak metaclass");
 122     Scalar::Util::weaken($meta);
 123     Class::MOP::remove_metaclass_by_name($meta->name);
 124     ok(!$meta, "removing a cached anon class means it's actually gone");
 125 }
 126
 127 done_testing;