t/018_anon_class.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 18;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 {
  10     package Foo;
  11     use strict;
  12     use warnings;
  13     use metaclass;
  14
  15     sub bar { 'Foo::bar' }
  16 }
  17
  18 my $anon_class_id;
  19 {
  20     my $instance;
  21     {
  22         my $anon_class = Class::MOP::Class->create_anon_class();
  23         isa_ok($anon_class, 'Class::MOP::Class');
  24
  25         ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/);
  26
  27         ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists');
  28         like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name');
  29
  30         is_deeply(
  31             [$anon_class->superclasses],
  32             [],
  33             '... got an empty superclass list');
  34         lives_ok {
  35             $anon_class->superclasses('Foo');
  36         } '... can add a superclass to anon class';
  37         is_deeply(
  38             [$anon_class->superclasses],
  39             [ 'Foo' ],
  40             '... got the right superclass list');
  41
  42         ok(!$anon_class->has_method('foo'), '... no foo method');
  43         lives_ok {
  44             $anon_class->add_method('foo' => sub { "__ANON__::foo" });
  45         } '... added a method to my anon-class';
  46         ok($anon_class->has_method('foo'), '... we have a foo method now');
  47
  48         $instance = $anon_class->new_object();
  49         isa_ok($instance, $anon_class->name);
  50         isa_ok($instance, 'Foo');
  51
  52         is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
  53         is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');
  54     }
  55
  56     ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package still exists');
  57 }
  58
  59 ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists');
  60
  61 # but it breaks down when we try to create another one ...
  62
  63 my $instance_2 = bless {} => ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id);
  64 isa_ok($instance_2, ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id));
  65 ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo');
  66 ok(!$instance_2->can('foo'), '... and it can no longer call the foo method');
  67
  68