use strict;
use warnings;
-use Test::More tests => 86;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
use Class::MOP;
{
-
package Foo;
use strict;
{
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;
- 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,
+ 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(
- [ $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'
+ { $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' );
- ok( $meta->is_mutable, '... our class is mutable' );
- 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_mutable, '... our class is not mutable' );
+ ok( $meta->is_immutable, '... our class is 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';
+ 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' );
- 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';
+ }, 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'],
);
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') ],
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' );
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';
+ }, 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' ],
);
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') ],
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' );
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';
+ }, 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' ],
);
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 ],
[
'... 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;
projects / gitmo/Class-MOP.git / blobdiff