t/006_new_and_clone_metaclasses.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use FindBin;
   7 use File::Spec::Functions;
   8
   9 use Test::More tests => 35;
  10 use Test::Exception;
  11
  12 use Class::MOP;
  13
  14 use lib catdir($FindBin::Bin, 'lib');
  15
  16 # make sure the Class::MOP::Class->meta does the right thing
  17
  18 my $meta = Class::MOP::Class->meta();
  19 isa_ok($meta, 'Class::MOP::Class');
  20
  21 my $new_meta = $meta->new_object('package' => 'Class::MOP::Class');
  22 isa_ok($new_meta, 'Class::MOP::Class');
  23 is($new_meta, $meta, '... it still creates the singleton');
  24
  25 my $cloned_meta = $meta->clone_object($meta);
  26 isa_ok($cloned_meta, 'Class::MOP::Class');
  27 is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it');
  28
  29 # make sure other metaclasses do the right thing
  30
  31 {
  32     package Foo;
  33     use metaclass;
  34 }
  35
  36 my $foo_meta = Foo->meta;
  37 isa_ok($foo_meta, 'Class::MOP::Class');
  38
  39 is($meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton');
  40 is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton');
  41
  42 # make sure subclassed of Class::MOP::Class do the right thing
  43
  44 my $my_meta = MyMetaClass->meta;
  45 isa_ok($my_meta, 'Class::MOP::Class');
  46
  47 my $new_my_meta = $my_meta->new_object('package' => 'MyMetaClass');
  48 isa_ok($new_my_meta, 'Class::MOP::Class');
  49 is($new_my_meta, $my_meta, '... even subclasses still create the singleton');
  50
  51 my $cloned_my_meta = $meta->clone_object($my_meta);
  52 isa_ok($cloned_my_meta, 'Class::MOP::Class');
  53 is($cloned_my_meta, $my_meta, '... and subclasses creates the singleton even if you try to clone it');
  54
  55 is($my_meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton (w/subclass)');
  56 is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton (w/subclass)');
  57
  58 # now create a metaclass for real
  59
  60 my $bar_meta = $my_meta->new_object('package' => 'Bar');
  61 isa_ok($bar_meta, 'Class::MOP::Class');
  62
  63 is($bar_meta->name, 'Bar', '... got the right name for the Bar metaclass');
  64 is($bar_meta->version, undef, '... Bar does not exists, so it has no version');
  65
  66 $bar_meta->superclasses('Foo');
  67
  68 # check with MyMetaClass
  69
  70 {
  71     package Baz;
  72     use metaclass 'MyMetaClass';
  73 }
  74
  75 my $baz_meta = Baz->meta;
  76 isa_ok($baz_meta, 'Class::MOP::Class');
  77 isa_ok($baz_meta, 'MyMetaClass');
  78
  79 is($my_meta->new_object('package' => 'Baz'), $baz_meta, '... got the right Baz->meta singleton');
  80 is($my_meta->clone_object($baz_meta), $baz_meta, '... cloning got the right Baz->meta singleton');
  81
  82 $baz_meta->superclasses('Bar');
  83
  84 # now create a regular objects for real
  85
  86 my $foo = $foo_meta->new_object();
  87 isa_ok($foo, 'Foo');
  88
  89 my $bar = $bar_meta->new_object();
  90 isa_ok($bar, 'Bar');
  91 isa_ok($bar, 'Foo');
  92
  93 my $baz = $baz_meta->new_object();
  94 isa_ok($baz, 'Baz');
  95 isa_ok($baz, 'Bar');
  96 isa_ok($baz, 'Foo');
  97
  98 my $cloned_foo = $foo_meta->clone_object($foo);
  99 isa_ok($cloned_foo, 'Foo');
 100
 101 isnt($cloned_foo, $foo, '... $cloned_foo is a new object different from $foo');
 102
 103 # check some errors
 104
 105 dies_ok {
 106     $foo_meta->clone_object($meta);
 107 } '... this dies as expected';
 108
 109 # test stuff
 110
 111 {
 112     package FooBar;
 113     use metaclass;
 114
 115     FooBar->meta->add_attribute('test');
 116 }
 117
 118 my $attr = FooBar->meta->get_attribute('test');
 119 isa_ok($attr, 'Class::MOP::Attribute');
 120
 121 my $attr_clone = $attr->clone();
 122 isa_ok($attr_clone, 'Class::MOP::Attribute');
 123
 124 isnt($attr, $attr_clone, '... we successfully cloned our attributes');
 125 is($attr->associated_class,
 126    $attr_clone->associated_class,
 127    '... we successfully did not clone our associated metaclass');
 128