From 9522bf6fed9c7eb8da5cd6684b609e84964fb0ac Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 20 May 2010 16:05:00 -0500
Subject: handle broken constructors that don't like to be subclassed
 (jhallock)

---
 lib/MooseX/NonMoose/Meta/Role/Class.pm       | 16 ++++++++++++++++
 lib/MooseX/NonMoose/Meta/Role/Constructor.pm | 17 ++++++++++++++++-
 2 files changed, 32 insertions(+), 1 deletion(-)

(limited to 'lib/MooseX/NonMoose')

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;
-- 
cgit v1.2.3-54-g00ecf