massive updates to the way immutable works to fix a big ish bug, please see new comme...
[gitmo/Class-MOP.git] / t / 071_immutable_w_custom_metaclass.t
CommitLineData
373a16ae 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
04dd7510 6use FindBin;
7use File::Spec::Functions;
8
9use Test::More tests => 10;
373a16ae 10use Test::Exception;
04dd7510 11use Scalar::Util;
373a16ae 12
13BEGIN {
14 use_ok('Class::MOP');
15}
16
04dd7510 17use lib catdir($FindBin::Bin, 'lib');
18
373a16ae 19{
04dd7510 20 package Foo;
21
373a16ae 22 use strict;
23 use warnings;
04dd7510 24 use metaclass;
25
26 __PACKAGE__->meta->make_immutable;
373a16ae 27
373a16ae 28 package Bar;
04dd7510 29
373a16ae 30 use strict;
31 use warnings;
04dd7510 32 use metaclass;
33
373a16ae 34 __PACKAGE__->meta->make_immutable;
04dd7510 35
373a16ae 36 package Baz;
04dd7510 37
373a16ae 38 use strict;
39 use warnings;
04dd7510 40 use metaclass 'MyMetaClass';
41
42 sub mymetaclass_attributes{
43 shift->meta->mymetaclass_attributes;
44 }
373a16ae 45
46 ::lives_ok {
04dd7510 47 Baz->meta->superclasses('Bar');
373a16ae 48 } '... we survive the metaclass incompatability test';
49}
50
04dd7510 51{
52 my $meta = Baz->meta;
53 is(Foo->meta->blessed, Bar->meta->blessed, 'Foo and Bar immutable metaclasses match');
54 is($meta->blessed, 'MyMetaClass', 'Baz->meta blessed as MyMetaClass');
55 ok(Baz->can('mymetaclass_attributes'), '... Baz can do method before immutable');
56 ok($meta->can('mymetaclass_attributes'), '... meta can do method before immutable');
57 $meta->make_immutable;
58 isa_ok($meta, 'MyMetaClass', 'Baz->meta');
59 ok(Baz->can('mymetaclass_attributes'), '... Baz can do method after imutable');
60 ok($meta->can('mymetaclass_attributes'), '... meta can do method after immutable');
61 isnt(Baz->meta->blessed, Bar->meta->blessed, 'Baz and Bar immutable metaclasses are different');
62}