diff options
Diffstat (limited to 't/exceptions/class-mop-class.t')
| -rw-r--r-- | t/exceptions/class-mop-class.t | 685 |
1 files changed, 685 insertions, 0 deletions
diff --git a/t/exceptions/class-mop-class.t b/t/exceptions/class-mop-class.t new file mode 100644 index 0000000..7e4a447 --- /dev/null +++ b/t/exceptions/class-mop-class.t @@ -0,0 +1,685 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +use Moose(); + +{ + my $exception = exception { + my $class = Class::MOP::Class::initialize; + }; + + like( + $exception, + qr/You must pass a package name and it cannot be blessed/, + "no package name given to initialize"); + + isa_ok( + $exception, + "Moose::Exception::InitializeTakesUnBlessedPackageName", + "no package name given to initialize"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class::create("Foo" => ( superclasses => ('foo') )); + }; + + like( + $exception, + qr/You must pass an ARRAY ref of superclasses/, + "an Array is of superclasses is passed"); + + isa_ok( + $exception, + "Moose::Exception::CreateMOPClassTakesArrayRefOfSuperclasses", + "an Array is of superclasses is passed"); + + is( + $exception->class, + 'Foo', + "an Array is of superclasses is passed"); +} + + +{ + my $exception = exception { + my $class = Class::MOP::Class::create("Foo" => ( attributes => ('foo') )); + }; + + like( + $exception, + qr/You must pass an ARRAY ref of attributes/, + "an Array is of attributes is passed"); + + isa_ok( + $exception, + "Moose::Exception::CreateMOPClassTakesArrayRefOfAttributes", + "an Array is of attributes is passed"); + + is( + $exception->class, + 'Foo', + "an Array is of attributes is passed"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class::create("Foo" => ( methods => ('foo') ) ); + }; + + like( + $exception, + qr/You must pass an HASH ref of methods/, + "a Hash is of methods is passed"); + + isa_ok( + $exception, + "Moose::Exception::CreateMOPClassTakesHashRefOfMethods", + "a Hash is of methods is passed"); + + is( + $exception->class, + 'Foo', + "a Hash is of methods is passed"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->create("Foo"); + $class->find_method_by_name; + }; + + like( + $exception, + qr/You must define a method name to find/, + "no method name given to find_method_by_name"); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotGiven", + "no method name given to find_method_by_name"); + + is( + $exception->class_name, + 'Foo', + "no method name given to find_method_by_name"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->create("Foo"); + $class->find_all_methods_by_name; + }; + + like( + $exception, + qr/You must define a method name to find/, + "no method name given to find_all_methods_by_name"); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotGiven", + "no method name given to find_all_methods_by_name"); + + is( + $exception->class_name, + 'Foo', + "no method name given to find_all_methods_by_name"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->create("Foo"); + $class->find_next_method_by_name; + }; + + like( + $exception, + qr/You must define a method name to find/, + "no method name given to find_next_method_by_name"); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotGiven", + "no method name given to find_next_method_by_name"); + + is( + $exception->class_name, + 'Foo', + "no method name given to find_next_method_by_name"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $foo = "foo"; + my $exception = exception { + $class->clone_object( $foo ); + }; + + like( + $exception, + qr/\QYou must pass an instance of the metaclass (Foo), not (foo)/, + "clone_object expects an instance of the metaclass"); + + isa_ok( + $exception, + "Moose::Exception::CloneObjectExpectsAnInstanceOfMetaclass", + "clone_object expects an instance of the metaclass"); + + is( + $exception->class_name, + 'Foo', + "clone_object expects an instance of the metaclass"); + + is( + $exception->instance, + 'foo', + "clone_object expects an instance of the metaclass"); +} + +{ + { + package Foo; + use Moose; + } + { + package Foo2; + use Moose; + } + my $foo2 = Foo2->new; + my $exception = exception { + Foo->meta->rebless_instance( $foo2 ); + }; + + like( + $exception, + qr/\QYou may rebless only into a subclass of (Foo2), of which (Foo) isn't./, + "you can rebless only into subclass"); + + isa_ok( + $exception, + "Moose::Exception::CanReblessOnlyIntoASubclass", + "you can rebless only into subclass"); + + is( + $exception->class_name, + 'Foo', + "you can rebless only into subclass"); + + is( + $exception->instance, + $foo2, + "you can rebless only into subclass"); +} + +{ + { + package Foo; + use Moose; + } + { + package Foo2; + use Moose; + } + my $foo = Foo->new; + my $exception = exception { + Foo2->meta->rebless_instance_back( $foo ); + }; + + like( + $exception, + qr/\QYou may rebless only into a superclass of (Foo), of which (Foo2) isn't./, + "you can rebless only into superclass"); + + isa_ok( + $exception, + "Moose::Exception::CanReblessOnlyIntoASuperclass", + "you can rebless only into superclass"); + + is( + $exception->instance, + $foo, + "you can rebless only into superclass"); + + is( + $exception->class_name, + "Foo2", + "you can rebless only into superclass"); +} + +{ + { + package Foo; + use Moose; + } + my $exception = exception { + Foo->meta->add_before_method_modifier; + }; + + like( + $exception, + qr/You must pass in a method name/, + "no method name passed to method modifier"); + + isa_ok( + $exception, + "Moose::Exception::MethodModifierNeedsMethodName", + "no method name passed to method modifier"); + + is( + $exception->class_name, + "Foo", + "no method name passed to method modifier"); +} + +{ + { + package Foo; + use Moose; + } + my $exception = exception { + Foo->meta->add_after_method_modifier; + }; + + like( + $exception, + qr/You must pass in a method name/, + "no method name passed to method modifier"); + + isa_ok( + $exception, + "Moose::Exception::MethodModifierNeedsMethodName", + "no method name passed to method modifier"); + + is( + $exception->class_name, + "Foo", + "no method name passed to method modifier"); +} + +{ + { + package Foo; + use Moose; + } + my $exception = exception { + Foo->meta->add_around_method_modifier; + }; + + like( + $exception, + qr/You must pass in a method name/, + "no method name passed to method modifier"); + + isa_ok( + $exception, + "Moose::Exception::MethodModifierNeedsMethodName", + "no method name passed to method modifier"); + + is( + $exception->class_name, + "Foo", + "no method name passed to method modifier"); +} + +{ + my $exception = exception { + my $class = Class::MOP::Class->_construct_class_instance; + }; + + like( + $exception, + qr/You must pass a package name/, + "no package name given to _construct_class_instance"); + + isa_ok( + $exception, + "Moose::Exception::ConstructClassInstanceTakesPackageName", + "no package name given to _construct_class_instance"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->add_before_method_modifier("foo"); + }; + + like( + $exception, + qr/The method 'foo' was not found in the inheritance hierarchy for Foo/, + 'method "foo" is not defined in class "Foo"'); + + isa_ok( + $exception, + "Moose::Exception::MethodNameNotFoundInInheritanceHierarchy", + 'method "foo" is not defined in class "Foo"'); + + is( + $exception->class_name, + 'Foo', + 'method "foo" is not defined in class "Foo"'); + + is( + $exception->method_name, + 'foo', + 'method "foo" is not defined in class "Foo"'); +} + +{ + { + package Bar; + use Moose; + } + my $bar = Bar->new; + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->new_object( ( __INSTANCE__ => $bar ) ); + }; + + like( + $exception, + qr/\QObjects passed as the __INSTANCE__ parameter must already be blessed into the correct class, but $bar is not a Foo/, + "__INSTANCE__ is not blessed correctly"); + #Objects passed as the __INSTANCE__ parameter must already be blessed into the correct class, but Bar=HASH(0x2d77528) is not a Foo + + isa_ok( + $exception, + "Moose::Exception::InstanceBlessedIntoWrongClass", + "__INSTANCE__ is not blessed correctly"); + + is( + $exception->class_name, + 'Foo', + "__INSTANCE__ is not blessed correctly"); + + is( + $exception->instance, + $bar, + "__INSTANCE__ is not blessed correctly"); +} + +{ + my $class = Class::MOP::Class->create("Foo"); + my $array = [1,2,3]; + my $exception = exception { + $class->new_object( ( __INSTANCE__ => $array ) ); + }; + + like( + $exception, + qr/\QThe __INSTANCE__ parameter must be a blessed reference, not $array/, + "__INSTANCE__ is not a blessed reference"); + #The __INSTANCE__ parameter must be a blessed reference, not ARRAY(0x1d75d40) + + isa_ok( + $exception, + "Moose::Exception::InstanceMustBeABlessedReference", + "__INSTANCE__ is not a blessed reference"); + + is( + $exception->class_name, + 'Foo', + "__INSTANCE__ is not a blessed reference"); + + is( + $exception->instance, + $array, + "__INSTANCE__ is not a blessed reference"); +} + +{ + my $array = [1, 2, 3]; + my $class = Class::MOP::Class->create("Foo"); + my $exception = exception { + $class->_clone_instance($array); + }; + + like( + $exception, + qr/\QYou can only clone instances, ($array) is not a blessed instance/, + "array reference was passed to _clone_instance instead of a blessed instance"); + #You can only clone instances, (ARRAY(0x2162350)) is not a blessed instance + + isa_ok( + $exception, + "Moose::Exception::OnlyInstancesCanBeCloned", + "array reference was passed to _clone_instance instead of a blessed instance"); + + is( + $exception->class_name, + "Foo", + "array reference was passed to _clone_instance instead of a blessed instance"); + + is( + $exception->instance, + $array, + "array reference was passed to _clone_instance instead of a blessed instance"); +} + +{ + { + package My::Role; + use Moose::Role; + } + + my $exception = exception { + Class::MOP::Class->create("My::Class", superclasses => ["My::Role"]); + }; + + like( + $exception, + qr/\QThe metaclass of My::Class (Class::MOP::Class) is not compatible with the metaclass of its superclass, My::Role (Moose::Meta::Role) /, + "Trying to inherit a Role"); + + isa_ok( + $exception, + "Moose::Exception::IncompatibleMetaclassOfSuperclass", + "Trying to inherit a Role"); + + is( + $exception->class_name, + "My::Class", + "Trying to inherit a Role"); + + is( + $exception->superclass_name, + "My::Role", + "Trying to inherit a Role"); +} + +{ + { + package Super::Class; + use Moose; + } + + my $class = Class::MOP::Class->create("TestClass", superclasses => ["Super::Class"]); + $class->immutable_trait(undef); + my $exception = exception { + $class->make_immutable( immutable_trait => ''); + }; + + like( + $exception, + qr/\Qno immutable trait specified for $class/, + "immutable_trait set to undef"); + #no immutable trait specified for Moose::Meta::Class=HASH(0x19a2280) + + isa_ok( + $exception, + "Moose::Exception::NoImmutableTraitSpecifiedForClass", + "immutable_trait set to undef"); + + is( + $exception->class_name, + "TestClass", + "immutable_trait set to undef"); +} + +{ + my $exception = exception { + package NoDestructorClass; + use Moose; + + __PACKAGE__->meta->make_immutable( destructor_class => undef, inline_destructor => 1 ); + }; + + like( + $exception, + qr/The 'inline_destructor' option is present, but no destructor class was specified/, + "destructor_class is set to undef"); + + isa_ok( + $exception, + "Moose::Exception::NoDestructorClassSpecified", + "destructor_class is set to undef"); + + is( + $exception->class_name, + "NoDestructorClass", + "destructor_class is set to undef"); +} + +{ + { + package Foo9::Meta::Role; + use Moose::Role; + } + + { + package Foo9::SuperClass::WithMetaRole; + use Moose -traits =>'Foo9::Meta::Role'; + } + + { + package Foo9::Meta::OtherRole; + use Moose::Role; + } + + { + package Foo9::SuperClass::After::Attribute; + use Moose -traits =>'Foo9::Meta::OtherRole'; + } + + my $exception = exception { + { + package Foo9; + use Moose; + my @superclasses = ('Foo9::SuperClass::WithMetaRole'); + extends @superclasses; + + has an_attribute_generating_methods => ( is => 'ro' ); + + push(@superclasses, 'Foo9::SuperClass::After::Attribute'); + + extends @superclasses; + } + }; + + like( + $exception, + qr/\QCan't fix metaclass incompatibility for Foo9 because it is not pristine./, + "cannot make metaclass compatible"); + + isa_ok( + $exception, + "Moose::Exception::CannotFixMetaclassCompatibility", + "cannot make metaclass compatible"); + + is( + $exception->class_name, + "Foo9", + "cannot make metaclass compatible"); +} + +{ + Class::MOP::Class->create( "Foo::Meta::Attribute", + superclasses => ["Class::MOP::Attribute"] + ); + + Class::MOP::Class->create( "Bar::Meta::Attribute", + superclasses => ["Class::MOP::Attribute"] + ); + + Class::MOP::Class->create( "Foo::Meta::Class", + superclasses => ["Class::MOP::Class"] + ); + + Foo::Meta::Class->create( + 'Foo::All', + attribute_metaclass => "Foo::Meta::Attribute", + ); + + { + Class::MOP::Class->create( + 'Foo::Unsafe', + attribute_metaclass => 'Foo::Meta::Attribute', + ); + + my $meta = Class::MOP::Class->create( + 'Foo::Unsafe::Sub', + ); + + $meta->add_attribute(foo => reader => 'foo'); + + my $exception = exception { + $meta->superclasses('Foo::Unsafe'); + }; + + like( + $exception, + qr/\QCan't fix metaclass incompatibility for Foo::Unsafe::Sub because it is not pristine./, + "cannot make metaclass compatible"); + + isa_ok( + $exception, + "Moose::Exception::CannotFixMetaclassCompatibility", + "cannot make metaclass compatible"); + + is( + $exception->class_name, + "Foo::Unsafe::Sub", + "cannot make metaclass compatible"); + } + + { + my $exception = exception { + Foo::Meta::Class->create( + "Foo::All::Sub::Attribute", + superclasses => ['Foo::All'], + attribute_metaclass => "Foo::Meta::Attribute", + attribute_metaclass => "Bar::Meta::Attribute", + ) + }; + + like( + $exception, + qr/\QThe attribute_metaclass metaclass for Foo::All::Sub::Attribute (Bar::Meta::Attribute) is not compatible with the attribute metaclass of its superclass, Foo::All (Foo::Meta::Attribute)/, + "incompatible attribute_metaclass"); + + isa_ok( + $exception, + "Moose::Exception::MetaclassTypeIncompatible", + "incompatible attribute_metaclass"); + + is( + $exception->class_name, + "Foo::All::Sub::Attribute", + "incompatible attribute_metaclass"); + + is( + $exception->superclass_name, + "Foo::All", + "incompatible attribute_metaclass"); + + is( + $exception->metaclass_type, + "attribute_metaclass", + "incompatible attribute_metaclass"); + } +} + +done_testing; |