t/800_shikabased/008-create_class.t

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