X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F070_immutable_metaclass.t;h=ca3ecf963cc02450960325e1c64900261b638a1b;hb=5e5102f19ccb1dc52b290577b0363e97dacbd5b3;hp=f81b0dd5dd4c104c2f7d69cf1821a31e3a32036a;hpb=5f3efd66c72c056da06be4eda139cdb7b7957730;p=gitmo%2FClass-MOP.git diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t index f81b0dd..ca3ecf9 100644 --- a/t/070_immutable_metaclass.t +++ b/t/070_immutable_metaclass.t @@ -1,14 +1,10 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 84; -use Test::Exception; +use Test::More; +use Test::Fatal; -BEGIN { - use_ok('Class::MOP'); -} +use Class::MOP; { package Foo; @@ -41,217 +37,256 @@ BEGIN { } { - 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($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 ], - [ $meta->blessed ], - '... immutable_metaclass superclasses are correct' - ); - ok($immutable_metaclass->has_method('get_mutable_metaclass_name')); + my $meta = Foo->meta; + my $original_metaclass_name = ref $meta; + + is_deeply( + { $meta->immutable_options }, {}, + 'immutable_options is empty before a class is made_immutable' + ); + $meta->make_immutable; + + my $immutable_metaclass = $meta->_immutable_metaclass->meta; + + my $immutable_class_name = $immutable_metaclass->name; + + ok( !$immutable_class_name->is_mutable, '... immutable_metaclass is not mutable' ); + ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' ); + is( $immutable_class_name->meta, $immutable_metaclass, + '... immutable_metaclass meta hack works' ); + + is_deeply( + { $meta->immutable_options }, + { + inline_accessors => 1, + inline_constructor => 1, + inline_destructor => 0, + debug => 0, + immutable_trait => 'Class::MOP::Class::Immutable::Trait', + constructor_name => 'new', + constructor_class => 'Class::MOP::Method::Constructor', + destructor_class => undef, + }, + 'immutable_options is empty before a class is made_immutable' + ); + + isa_ok( $meta, "Class::MOP::Class" ); } { my $meta = Foo->meta; - is($meta->name, 'Foo', '... checking the Foo metaclass'); + 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_mutable, '... our class is not mutable' ); + ok( $meta->is_immutable, '... our class is immutable' ); - lives_ok { - $meta->make_immutable(); - } '... changed Foo 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'); + isa_ok( $meta, 'Class::MOP::Class' ); - isa_ok($meta, 'Class::MOP::Class'); + isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' ); - 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'; + isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' ); - dies_ok { $meta->add_attribute() } '... exception thrown as expected'; - dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; + isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_package_symbol() }, undef, '... 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'; + is( exception { $meta->identifier() }, undef, '... no exception for get_package_symbol special case' ); my @supers; - lives_ok { + is( exception { @supers = $meta->superclasses; - } '... got the superclasses okay'; + }, undef, '... got the superclasses okay' ); - dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; + isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' ); my $meta_instance; - lives_ok { + is( exception { $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'); + }, undef, '... 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 { + is( exception { @cpl = $meta->class_precedence_list; - } '... got the class precedence list okay'; + }, undef, '... got the class precedence list okay' ); is_deeply( - \@cpl, - [ 'Foo' ], - '... we just have ourselves in the class precedence list'); + \@cpl, + ['Foo'], + '... we just have ourselves in the class precedence list' + ); my @attributes; - lives_ok { - @attributes = $meta->compute_all_applicable_attributes; - } '... got the attribute list okay'; + is( exception { + @attributes = $meta->get_all_attributes; + }, undef, '... got the attribute list okay' ); is_deeply( - \@attributes, - [ $meta->get_attribute('bar') ], - '... got the right list of attributes'); + \@attributes, + [ $meta->get_attribute('bar') ], + '... got the right list of attributes' + ); } { 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_mutable, '... our class is mutable' ); + ok( !$meta->is_immutable, '... our class is not immutable' ); - lives_ok { + is( exception { $meta->make_immutable(); - } '... changed Bar to be immutable'; + }, undef, '... changed Bar to be immutable' ); - ok(!$meta->make_immutable, '... make immutable now returns nothing'); + 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_mutable, '... our class is no longer mutable' ); + ok( $meta->is_immutable, '... our class is now immutable' ); - isa_ok($meta, 'Class::MOP::Class'); + 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'; + isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' ); - dies_ok { $meta->add_attribute() } '... exception thrown as expected'; - dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; + isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' ); - dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; - dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; + isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' ); my @supers; - lives_ok { + is( exception { @supers = $meta->superclasses; - } '... got the superclasses okay'; + }, undef, '... got the superclasses okay' ); - dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; + isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' ); my $meta_instance; - lives_ok { + is( exception { $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'); + }, undef, '... 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 { + is( exception { @cpl = $meta->class_precedence_list; - } '... got the class precedence list okay'; + }, undef, '... got the class precedence list okay' ); is_deeply( - \@cpl, - [ 'Bar', 'Foo'], - '... we just have ourselves in the class precedence list'); + \@cpl, + [ 'Bar', 'Foo' ], + '... we just have ourselves in the class precedence list' + ); my @attributes; - lives_ok { - @attributes = $meta->compute_all_applicable_attributes; - } '... got the attribute list okay'; + is( exception { + @attributes = $meta->get_all_attributes; + }, undef, '... got the attribute list okay' ); is_deeply( - [ sort { $a->name cmp $b->name } @attributes ], - [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ], - '... got the right list of attributes'); + [ sort { $a->name cmp $b->name } @attributes ], + [ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ], + '... got the right list of attributes' + ); } { 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_mutable, '... our class is mutable' ); + ok( !$meta->is_immutable, '... our class is not immutable' ); - lives_ok { + is( exception { $meta->make_immutable(); - } '... changed Baz to be immutable'; + }, undef, '... changed Baz to be immutable' ); - ok(!$meta->make_immutable, '... make immutable now returns nothing'); + 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_mutable, '... our class is no longer mutable' ); + ok( $meta->is_immutable, '... our class is now immutable' ); - isa_ok($meta, 'Class::MOP::Class'); + 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'; + isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' ); - dies_ok { $meta->add_attribute() } '... exception thrown as expected'; - dies_ok { $meta->remove_attribute() } '... exception thrown as expected'; + isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' ); - dies_ok { $meta->add_package_symbol() } '... exception thrown as expected'; - dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected'; + isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' ); + isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' ); my @supers; - lives_ok { + is( exception { @supers = $meta->superclasses; - } '... got the superclasses okay'; + }, undef, '... got the superclasses okay' ); - dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay'; + isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' ); my $meta_instance; - lives_ok { + is( exception { $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'); + }, undef, '... 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 { + is( exception { @cpl = $meta->class_precedence_list; - } '... got the class precedence list okay'; + }, undef, '... got the class precedence list okay' ); is_deeply( - \@cpl, - [ 'Baz', 'Bar', 'Foo'], - '... we just have ourselves in the class precedence list'); + \@cpl, + [ 'Baz', 'Bar', 'Foo' ], + '... we just have ourselves in the class precedence list' + ); my @attributes; - lives_ok { - @attributes = $meta->compute_all_applicable_attributes; - } '... got the attribute list okay'; + is( exception { + @attributes = $meta->get_all_attributes; + }, undef, '... got the attribute list okay' ); is_deeply( - [ sort { $a->name cmp $b->name } @attributes ], - [ $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('baz') ], - '... got the right list of attributes'); + [ sort { $a->name cmp $b->name } @attributes ], + [ + $meta->get_attribute('bah'), Foo->meta->get_attribute('bar'), + Bar->meta->get_attribute('baz') + ], + '... got the right list of attributes' + ); } +# This test probably needs to go last since it will muck up the Foo class +{ + my $meta = Foo->meta; + + $meta->make_mutable; + $meta->make_immutable( + inline_accessors => 0, + inline_constructor => 0, + constructor_name => 'newer', + ); + + is_deeply( + { $meta->immutable_options }, + { + inline_accessors => 0, + inline_constructor => 0, + inline_destructor => 0, + debug => 0, + immutable_trait => 'Class::MOP::Class::Immutable::Trait', + constructor_name => 'newer', + constructor_class => 'Class::MOP::Method::Constructor', + destructor_class => undef, + }, + 'custom immutable_options are returned by immutable_options accessor' + ); +} +done_testing;