diff options
author | Jesse Luehrs <doy@tozt.net> | 2010-05-20 16:05:00 -0500 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2010-05-20 16:05:59 -0500 |
commit | 9522bf6fed9c7eb8da5cd6684b609e84964fb0ac (patch) | |
tree | 44ca1092fee41881d55cce97e04baac83dc2e131 /lib/MooseX/NonMoose | |
parent | 6c5baf303da194c2388fd5efb2ab7f69767e80a4 (diff) | |
download | moosex-nonmoose-9522bf6fed9c7eb8da5cd6684b609e84964fb0ac.tar.gz moosex-nonmoose-9522bf6fed9c7eb8da5cd6684b609e84964fb0ac.zip |
handle broken constructors that don't like to be subclassed (jhallock)
Diffstat (limited to 'lib/MooseX/NonMoose')
-rw-r--r-- | lib/MooseX/NonMoose/Meta/Role/Class.pm | 16 | ||||
-rw-r--r-- | lib/MooseX/NonMoose/Meta/Role/Constructor.pm | 17 |
2 files changed, 32 insertions, 1 deletions
diff --git a/lib/MooseX/NonMoose/Meta/Role/Class.pm b/lib/MooseX/NonMoose/Meta/Role/Class.pm index 5f78326..cc7275e 100644 --- a/lib/MooseX/NonMoose/Meta/Role/Class.pm +++ b/lib/MooseX/NonMoose/Meta/Role/Class.pm @@ -142,6 +142,22 @@ sub _check_superclass_constructor { ? $class->FOREIGNBUILDARGS(@_) : @_; my $instance = $super_new->execute($class, @foreign_params); + if (!blessed($instance)) { + confess "The constructor for " + . $super_new->associated_metaclass->name + . " did not return a blessed instance"; + } + elsif (!$instance->isa($class)) { + if (!$class->isa(blessed($instance))) { + confess "The constructor for " + . $super_new->associated_metaclass->name + . " returned an object whose class is not a parent of " + . $class; + } + else { + bless $instance, $class; + } + } return Class::MOP::Class->initialize($class)->new_object( __INSTANCE__ => $instance, %$params, diff --git a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm index 9a69d7c..d0ececb 100644 --- a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm +++ b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm @@ -59,7 +59,22 @@ sub _generate_instance { ? "${class_var}->FOREIGNBUILDARGS(\@_)" : '@_'; my $instance = "$super_new_class->$new($arglist)"; - "my $var = " . $self->_meta_instance->inline_rebless_instance_structure($instance, $class_var) . ";\n"; + return "my $var = $instance;\n" + . "if (!Scalar::Util::blessed($var)) {\n" + . " " . $self->_inline_throw_error( + "'The constructor for $super_new_class did not return a blessed instance'" + ) . ";\n" + . "}\n" + . "elsif (!$var->isa($class_var)) {\n" + . " if (!$class_var->isa(Scalar::Util::blessed($var))) {\n" + . " " . $self->_inline_throw_error( + "\"The constructor for $super_new_class returned an object whose class is not a parent of $class_var\"" + ) . ";\n" + . " }\n" + . " else {\n" + . " " . $self->_meta_instance->inline_rebless_instance_structure($var, $class_var) . ";\n" + . " }\n" + . "}\n"; } no Moose::Role; |