t/018_anon_class.t

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