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;