warn instead of die if the superclass has a DESTROY but no new

2 files changed, 39 insertions, 2 deletions

diff --git a/lib/MooseX/NonMoose/Meta/Role/Class.pm b/lib/MooseX/NonMoose/Meta/Role/Class.pm
index 1d1796a..6c09b22 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Class.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Class.pm
@@ -57,14 +57,25 @@ sub _determine_constructor_options {
         unless $cc_meta->can('does_role')
             && $cc_meta->does_role('MooseX::NonMoose::Meta::Role::Constructor');
 
+    # XXX: get constructor name from the constructor metaclass?
+    my $local_constructor = $self->get_method('new');
+    if (!defined($local_constructor)) {
+        warn "Not inlining a constructor for " . $self->name . " since "
+           . "its parent " . ($self->superclasses)[0] . " doesn't contain a "
+           . "'new' method. "
+           . "If you are certain you don't need to inline your"
+           . " constructor, specify inline_constructor => 0 in your"
+           . " call to " . $self->name . "->meta->make_immutable\n";
+        return @options;
+    }
+
     # do nothing if extends was called, but we then added a method modifier to
     # the constructor (this will warn, but that's okay)
     # XXX: this is a fairly big hack, but it should cover most of the cases
     # that actually show up in practice... it would be nice to do this properly
     # though
-    # XXX: get constructor name from the constructor metaclass?
     return @options
-        if $self->get_method('new')->isa('Class::MOP::Method::Wrapped');
+        if $local_constructor->isa('Class::MOP::Method::Wrapped');
 
     # do nothing if we explicitly ask for the constructor to not be inlined
     my %options = @options;
diff --git a/t/26-no-new-constructor-error.t b/t/26-no-new-constructor-error.t
new file mode 100644
index 0000000..e70442e
--- /dev/null
+++ b/t/26-no-new-constructor-error.t
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+{
+    package NonMoose;
+    sub create { bless {}, shift }
+    sub DESTROY { }
+}
+
+{
+    package Child;
+    use Moose;
+    use MooseX::NonMoose;
+    extends 'NonMoose';
+    {
+        my $warning;
+        local $SIG{__WARN__} = sub { $warning = $_[0] };
+        __PACKAGE__->meta->make_immutable;
+        ::like($warning, qr/Not inlining.*doesn't contain a 'new' method/,
+            "warning when trying to make_immutable without a superclass 'new'");
+    }
+}
+
+done_testing;