X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F070_immutable_metaclass.t;h=3814526580d12a968eadf5ea8047c17e4690e16a;hb=f881381757cf823671097756344ee1dad02cb473;hp=d057136af70542acb946968f0791b890d620cbcc;hpb=373a16aed9249f13e466532ef9a840b92a61f173;p=gitmo%2FClass-MOP.git diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t index d057136..3814526 100644 --- a/t/070_immutable_metaclass.t +++ b/t/070_immutable_metaclass.t @@ -1,98 +1,129 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 77; +use Test::More tests => 86; use Test::Exception; -BEGIN { - use_ok('Class::MOP'); - use_ok('Class::MOP::Class::Immutable'); -} +use Class::MOP; { package Foo; - + use strict; use warnings; use metaclass; - + __PACKAGE__->meta->add_attribute('bar'); - + package Bar; - + use strict; use warnings; use metaclass; - + __PACKAGE__->meta->superclasses('Foo'); - __PACKAGE__->meta->add_attribute('baz'); - + __PACKAGE__->meta->add_attribute('baz'); + package Baz; - + use strict; use warnings; use metaclass; - + __PACKAGE__->meta->superclasses('Bar'); - __PACKAGE__->meta->add_attribute('bah'); + __PACKAGE__->meta->add_attribute('bah'); +} + +{ + my $meta = Foo->meta; + + my $transformer; + lives_ok{ $transformer = $meta->create_immutable_transformer } + "Created immutable transformer"; + isa_ok($transformer, 'Class::MOP::Immutable', '... transformer isa Class::MOP::Immutable'); + my $methods = $transformer->create_methods_for_immutable_metaclass; + + my $immutable_metaclass = $transformer->immutable_metaclass; + is($transformer->metaclass, $meta, '... transformer has correct metaclass'); + ok(!$transformer->inlined_constructor, '... transformer says it did not inline the constructor'); + ok($immutable_metaclass->is_anon_class, '... immutable_metaclass is an anonymous class'); + + #I don't understand why i need to ->meta here... + my $obj = $immutable_metaclass->name; + ok(!$obj->is_mutable, '... immutable_metaclass is not mutable'); + ok($obj->is_immutable, '... immutable_metaclass is immutable'); + ok(!$obj->make_immutable, '... immutable_metaclass make_mutable is noop'); + is($obj->meta, $immutable_metaclass, '... immutable_metaclass meta hack works'); + + is_deeply( + [ $immutable_metaclass->superclasses ], + [ Scalar::Util::blessed($meta) ], + '... immutable_metaclass superclasses are correct' + ); + ok($immutable_metaclass->has_method('get_mutable_metaclass_name'), + 'immutable metaclass has get_mutable_metaclass_name method'); + } { my $meta = Foo->meta; is($meta->name, 'Foo', '... checking the Foo metaclass'); - + ok($meta->is_mutable, '... our class is mutable'); - ok(!$meta->is_immutable, '... our class is not immutable'); + ok(!$meta->is_immutable, '... our class is not immutable'); + + my $transformer = $meta->get_immutable_transformer; lives_ok { $meta->make_immutable(); } '... changed Foo to be immutable'; - + + ok($transformer->inlined_constructor, '... transformer says it did inline the constructor'); + is($transformer, $meta->get_immutable_transformer, '... immutable transformer cache works'); ok(!$meta->make_immutable, '... make immutable now returns nothing'); - + ok(!$meta->is_mutable, '... our class is no longer mutable'); - ok($meta->is_immutable, '... our class is now immutable'); + ok($meta->is_immutable, '... our class is now immutable'); - isa_ok($meta, 'Class::MOP::Class::Immutable'); isa_ok($meta, 'Class::MOP::Class'); - + dies_ok { $meta->add_method() } '... exception thrown as expected'; dies_ok { $meta->alias_method() } '... exception thrown as expected'; dies_ok { $meta->remove_method() } '... exception thrown as expected'; - + dies_ok { $meta->add_attribute() } '... exception thrown as expected'; dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; - + dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; + lives_ok { $meta->identifier() } '... no exception for get_package_symbol special case'; + my @supers; lives_ok { @supers = $meta->superclasses; } '... got the superclasses okay'; dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; - + my $meta_instance; lives_ok { $meta_instance = $meta->get_meta_instance; } '... got the meta instance okay'; isa_ok($meta_instance, 'Class::MOP::Instance'); is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); - + my @cpl; lives_ok { @cpl = $meta->class_precedence_list; - } '... got the class precedence list okay'; + } '... got the class precedence list okay'; is_deeply( \@cpl, [ 'Foo' ], '... we just have ourselves in the class precedence list'); - + my @attributes; lives_ok { @attributes = $meta->compute_all_applicable_attributes; @@ -105,30 +136,29 @@ BEGIN { { my $meta = Bar->meta; - is($meta->name, 'Bar', '... checking the Bar metaclass'); - + is($meta->name, 'Bar', '... checking the Bar metaclass'); + ok($meta->is_mutable, '... our class is mutable'); - ok(!$meta->is_immutable, '... our class is not immutable'); + ok(!$meta->is_immutable, '... our class is not immutable'); lives_ok { $meta->make_immutable(); } '... changed Bar to be immutable'; - + ok(!$meta->make_immutable, '... make immutable now returns nothing'); - + ok(!$meta->is_mutable, '... our class is no longer mutable'); - ok($meta->is_immutable, '... our class is now immutable'); + ok($meta->is_immutable, '... our class is now immutable'); - isa_ok($meta, 'Class::MOP::Class::Immutable'); isa_ok($meta, 'Class::MOP::Class'); - + dies_ok { $meta->add_method() } '... exception thrown as expected'; dies_ok { $meta->alias_method() } '... exception thrown as expected'; dies_ok { $meta->remove_method() } '... exception thrown as expected'; - + dies_ok { $meta->add_attribute() } '... exception thrown as expected'; dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; - + dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; @@ -138,23 +168,23 @@ BEGIN { } '... got the superclasses okay'; dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; - + my $meta_instance; lives_ok { $meta_instance = $meta->get_meta_instance; } '... got the meta instance okay'; isa_ok($meta_instance, 'Class::MOP::Instance'); - is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); - + is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); + my @cpl; lives_ok { @cpl = $meta->class_precedence_list; - } '... got the class precedence list okay'; + } '... got the class precedence list okay'; is_deeply( \@cpl, [ 'Bar', 'Foo'], '... we just have ourselves in the class precedence list'); - + my @attributes; lives_ok { @attributes = $meta->compute_all_applicable_attributes; @@ -167,30 +197,29 @@ BEGIN { { my $meta = Baz->meta; - is($meta->name, 'Baz', '... checking the Baz metaclass'); - + is($meta->name, 'Baz', '... checking the Baz metaclass'); + ok($meta->is_mutable, '... our class is mutable'); - ok(!$meta->is_immutable, '... our class is not immutable'); + ok(!$meta->is_immutable, '... our class is not immutable'); lives_ok { $meta->make_immutable(); } '... changed Baz to be immutable'; - + ok(!$meta->make_immutable, '... make immutable now returns nothing'); - + ok(!$meta->is_mutable, '... our class is no longer mutable'); - ok($meta->is_immutable, '... our class is now immutable'); + ok($meta->is_immutable, '... our class is now immutable'); - isa_ok($meta, 'Class::MOP::Class::Immutable'); isa_ok($meta, 'Class::MOP::Class'); - + dies_ok { $meta->add_method() } '... exception thrown as expected'; dies_ok { $meta->alias_method() } '... exception thrown as expected'; dies_ok { $meta->remove_method() } '... exception thrown as expected'; - + dies_ok { $meta->add_attribute() } '... exception thrown as expected'; dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; - + dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; @@ -200,23 +229,23 @@ BEGIN { } '... got the superclasses okay'; dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; - + my $meta_instance; lives_ok { $meta_instance = $meta->get_meta_instance; } '... got the meta instance okay'; isa_ok($meta_instance, 'Class::MOP::Instance'); - is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); - + is($meta_instance, $meta->get_meta_instance, '... and we know it is cached'); + my @cpl; lives_ok { @cpl = $meta->class_precedence_list; - } '... got the class precedence list okay'; + } '... got the class precedence list okay'; is_deeply( \@cpl, [ 'Baz', 'Bar', 'Foo'], '... we just have ourselves in the class precedence list'); - + my @attributes; lives_ok { @attributes = $meta->compute_all_applicable_attributes;