t/001_mouse/808-create_class.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 25;
   4 use Test::Exception;
   5
   6 use Mouse ();
   7
   8 # error handling
   9 throws_ok {
  10     Mouse::Meta::Class->create(
  11         "ClassName",
  12         superclasses => "foo"
  13     );
  14 } qr/You must pass an ARRAY ref of superclasses/;
  15
  16
  17 throws_ok {
  18     Mouse::Meta::Class->create(
  19         "ClassName",
  20         attributes => "foo"
  21     );
  22 } qr/You must pass an ARRAY ref of attributes/;
  23
  24 throws_ok {
  25     Mouse::Meta::Class->create(
  26         "ClassName",
  27         methods => "foo"
  28     );
  29 } qr/You must pass a HASH ref of methods/;
  30
  31 # normal cases
  32 isa_ok(Mouse::Meta::Class->create("FooBar"), "Mouse::Meta::Class");
  33 is FooBar->meta->name, "FooBar";
  34
  35 isa_ok(
  36     Mouse::Meta::Class->create(
  37         "Baz",
  38         superclasses => [ "FooBar", "Mouse::Object" ],
  39         attributes   => [
  40             Mouse::Meta::Attribute->new(
  41                 "foo" => (
  42                     is => "rw",
  43                     default => "yay",
  44                 ),
  45             )
  46         ],
  47         methods => {
  48             dooo => sub { "iiiit" },
  49         }
  50     ),
  51     "Mouse::Meta::Class"
  52 );
  53 isa_ok Baz->new(), "FooBar";
  54 is Baz->new()->foo, "yay";
  55 is Baz->new()->dooo, "iiiit";
  56
  57 my($anon_pkg1, $anon_pkg2);
  58 {
  59     my $meta = Mouse::Meta::Class->create_anon_class(
  60         superclasses => [ "Mouse::Object" ],
  61         methods => {
  62             dooo => sub { "iiiit" },
  63         }
  64     );
  65     $anon_pkg1 = $meta->name;
  66
  67     isa_ok($meta, "Mouse::Meta::Class", 'create_anon_class');
  68     ok($meta->is_anon_class, 'is_anon_class');
  69     is $meta->name->new->dooo(), "iiiit";
  70
  71     my $anon2 = Mouse::Meta::Class->create_anon_class(cache => 1);
  72     $anon_pkg2 = $anon2->name;
  73
  74     ok($anon2->is_anon_class);
  75
  76     isnt $meta, $anon2;
  77     isnt $meta->name, $anon2->name;
  78 }
  79
  80 # all the stuff are removed?
  81 ok !$anon_pkg1->isa('Mouse::Object');
  82 ok !$anon_pkg1->can('dooo');
  83 ok !$anon_pkg1->can('meta');
  84
  85 ok $anon_pkg2->can('meta'), 'cache => 1 makes it immortal';
  86
  87 my $anon = Mouse::Meta::Class->create_anon_class(
  88     constructor_class => 'ConstructorX',
  89     destructor_class  => 'DestructorX',
  90 );
  91
  92 is $anon->constructor_class, 'ConstructorX';
  93 is $anon->destructor_class,  'DestructorX';
  94
  95 my $obj;
  96 {
  97     my $anon = Mouse::Meta::Class->create_anon_class(superclasses => ['Mouse::Object']);
  98     lives_ok{ $anon->make_immutable() } 'make anon class immutable';
  99     $obj = $anon->name->new();
 100 }
 101
 102 SKIP:{
 103     skip 'Moose has a bug', 3 if 'Mouse' eq 'Moose';
 104
 105     isa_ok $obj, 'Mouse::Object';
 106     can_ok $obj, 'meta';
 107     lives_and{
 108         isa_ok $obj->meta, 'Mouse::Meta::Class';
 109     };
 110 }