fix edge case with inlined fallback constructors

need to handle hashref parameters

2 files changed, 79 insertions, 1 deletions

diff --git a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
index 57316c9..b42b59f 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
@@ -69,7 +69,18 @@ sub _generate_fallback_constructor {
                 ? "${class_var}->FOREIGNBUILDARGS(\@_)"
                 : '@_';
     my $instance = "${class_var}->${super_new_class}::$new($arglist)";
-    "${class_var}->Moose::Object::new(__INSTANCE__ => $instance, \@_)"
+    # XXX: the "my $__DUMMY = " part is because "return do" triggers a weird
+    # bug in pre-5.12 perls (it ends up returning undef)
+    "my \$__DUMMY = do {\n"
+  . "    if (ref(\$_[0]) eq 'HASH') {\n"
+  . "        \$_[0]->{__INSTANCE__} = $instance\n"
+  . "            unless exists \$_[0]->{__INSTANCE__};\n"
+  . "    }\n"
+  . "    else {\n"
+  . "        unshift \@_, __INSTANCE__ => $instance;\n"
+  . "    }\n"
+  . "    ${class_var}->Moose::Object::new(\@_);\n"
+  . "}";
 }
 
 sub _generate_instance {
diff --git a/t/052-hashref-constructor.t b/t/052-hashref-constructor.t
new file mode 100644
index 0000000..74fd530
--- /dev/null
+++ b/t/052-hashref-constructor.t
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+    package Foo;
+
+    sub new {
+        my $class = shift;
+        bless { ref($_[0]) ? %{$_[0]} : @_ }, $class;
+    }
+
+    sub foo {
+        my $self = shift;
+        $self->{foo};
+    }
+}
+
+{
+    package Bar;
+    use Moose;
+    use MooseX::NonMoose;
+
+    extends 'Foo';
+
+    has _bar => (
+        init_arg => 'bar',
+        reader   => 'bar',
+    );
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+{
+    package Baz;
+    use Moose;
+
+    extends 'Bar';
+
+    has _baz => (
+        init_arg => 'baz',
+        reader   => 'baz',
+    );
+}
+
+{
+    my $baz;
+    lives_ok { $baz = Baz->new( foo => 1, bar => 2, baz => 3 ) }
+             "constructor lives";
+    is($baz->foo, 1, "foo set");
+    is($baz->bar, 2, "bar set");
+    is($baz->baz, 3, "baz set");
+
+}
+
+{
+    my $baz;
+    lives_ok { $baz = Baz->new({foo => 1, bar => 2, baz => 3}) }
+             "constructor lives (hashref)";
+    is($baz->foo, 1, "foo set (hashref)");
+    is($baz->bar, 2, "bar set (hashref)");
+    is($baz->baz, 3, "baz set (hashref)");
+}
+
+done_testing;