t/018_anon_class.t

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