t/018_anon_class.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 24;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11 }
  12
  13 {
  14     package Foo;
  15     use strict;
  16     use warnings;
  17     use metaclass;
  18
  19     sub bar { 'Foo::bar' }
  20 }
  21
  22 my $anon_class_id;
  23 my $instance;
  24 {
  25     my $anon_class = Class::MOP::Class->create_anon_class();
  26     isa_ok($anon_class, 'Class::MOP::Class');
  27
  28     ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/);
  29
  30     ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists');
  31     like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name');
  32
  33     is_deeply(
  34         [$anon_class->superclasses],
  35         [],
  36         '... got an empty superclass list');
  37     lives_ok {
  38         $anon_class->superclasses('Foo');
  39     } '... can add a superclass to anon class';
  40     is_deeply(
  41         [$anon_class->superclasses],
  42         [ 'Foo' ],
  43         '... got the right superclass list');
  44
  45     ok(!$anon_class->has_method('foo'), '... no foo method');
  46     lives_ok {
  47         $anon_class->add_method('foo' => sub { "__ANON__::foo" });
  48     } '... added a method to my anon-class';
  49     ok($anon_class->has_method('foo'), '... we have a foo method now');
  50
  51     $instance = $anon_class->new_object();
  52     isa_ok($instance, $anon_class->name);
  53     isa_ok($instance, 'Foo');
  54
  55     is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
  56     is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');
  57 }
  58
  59 ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists');
  60
  61 # the superclass relationship actually
  62 # still exists for the instance ...
  63 isa_ok($instance, 'Foo');
  64
  65 # and oddly enough we can still
  66 # call methods on our instance
  67 can_ok($instance, 'foo');
  68 can_ok($instance, 'bar');
  69
  70 is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
  71 is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');
  72
  73 # but it breaks down when we try to create another one ...
  74
  75 my $instance_2 = bless {} => ref($instance);
  76 isa_ok($instance_2, ref($instance));
  77 ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo');
  78 ok(!$instance_2->can('foo'), '... and it can no longer call the foo method');
  79
  80 # NOTE:
  81 # I bumped this test up to 100_000 instances, and
  82 # still got not conflicts. If your application needs
  83 # more than that, your probably mst
  84
  85 my %conflicts;
  86 foreach my $i (1 .. 100) {
  87     $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef;
  88 }
  89 is(scalar(keys %conflicts), 100, '... got as many classes as I would expect');
  90