From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 6 Dec 2010 21:36:30 +0000 (+0000)
Subject: handle non-Moo superclass constructors
X-Git-Tag: release_0.9.4~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=de5c0e53cb298387d7393bbb4e269d970c257851;p=gitmo%2FMoo.git

handle non-Moo superclass constructors
---

diff --git a/Changes b/Changes
index 7f14e19..4f3d3b0 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - Automatic detection on non-Moo superclasses
+
 0.9.3 Sun Dec 5 2010
   - Fix _load_module to deal with pre-existing subpackages
 
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 2360006..c7138a1 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -20,6 +20,11 @@ sub accessor_generator {
   $_[0]->{accessor_generator}
 }
 
+sub construction_string {
+  my ($self) = @_;
+  $self->{construction_string} or 'bless({}, $class);'
+}
+
 sub install_delayed {
   my ($self) = @_;
   my $package = $self->{package};
@@ -40,7 +45,7 @@ sub generate_method {
   my $body = '    my $class = shift;'."\n";
   $body .= $self->_generate_args;
   $body .= $self->_check_required($spec);
-  $body .= '    my $new = bless({}, $class);'."\n";
+  $body .= '    my $new = '.$self->construction_string.";\n";
   $body .= $self->_assign_new($spec);
   if ($into->can('BUILD')) {
     require Method::Generate::BuildAll;
diff --git a/lib/Moo.pm b/lib/Moo.pm
index 571415e..badb96d 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -52,27 +52,32 @@ sub _constructor_maker_for {
   return unless $MAKERS{$target};
   $MAKERS{$target}{constructor} ||= do {
     require Method::Generate::Constructor;
+    my $con;
+
+    # using the -last- entry in @ISA means that classes created by
+    # Role::Tiny as N roles + superclass will still get the attributes
+    # from the superclass via the ->register_attribute_specs call later
+
+    if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[-1] }) {
+      $con = $MAKERS{$super}{constructor} if $MAKERS{$super};
+    }
+    my $moo_constructor = !!$con || do {
+      my $t_new = $target->can('new');
+      $t_new and $t_new == Moo::Object->can('new');
+    };
+    require Moo::_mro unless $moo_constructor;
     Method::Generate::Constructor
       ->new(
         package => $target,
         accessor_generator => do {
           require Method::Generate::Accessor;
           Method::Generate::Accessor->new;
-        }
+        },
+        ($moo_constructor ? ()
+          : (construction_string => '$class->next::method(@_)'))
       )
       ->install_delayed
-      ->register_attribute_specs(do {
-        my @spec;
-        # using the -last- entry in @ISA means that classes created by
-        # Role::Tiny as N roles + superclass will still get the attributes
-        # from the superclass
-        if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[-1] }) {
-          if (my $con = $MAKERS{$super}{constructor}) {
-            @spec = %{$con->all_attribute_specs};
-          }
-        }
-        @spec;
-      });
+      ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}})
   }
 }
 
diff --git a/t/extends-non-moo.t b/t/extends-non-moo.t
new file mode 100644
index 0000000..9c6beb1
--- /dev/null
+++ b/t/extends-non-moo.t
@@ -0,0 +1,56 @@
+use strictures 1;
+use Test::More;
+
+{
+    package t::moo::extends_non_moo::base;
+
+    sub new {
+        my ($proto, $args) = @_;
+        bless $args, $proto;
+    }
+
+    sub to_app {
+        (shift)->{app};
+    }
+
+    package t::moo::extends_non_moo::middle;
+    use base qw(t::moo::extends_non_moo::base);
+
+    sub wrap {
+        my($class, $app) = @_;
+        $class->new({app => $app})
+              ->to_app;
+    }
+ 
+    package t::moo::extends_non_moo::moo;
+    use Moo;
+    extends 't::moo::extends_non_moo::middle';
+
+    package t::moo::extends_non_moo::moo_with_attr;
+    use Moo;
+    extends 't::moo::extends_non_moo::middle';
+    has 'attr' => (is=>'ro');
+}
+
+ok my $app = 100,
+  'prepared $app';
+
+ok $app = t::moo::extends_non_moo::middle->wrap($app),
+  '$app from $app';
+
+is $app, 100,
+  '$app still 100';
+
+ok $app = t::moo::extends_non_moo::moo->wrap($app),
+  '$app from $app';
+
+is $app, 100,
+  '$app still 100';
+
+ok $app = t::moo::extends_non_moo::moo_with_attr->wrap($app),
+  '$app from $app';
+
+is $app, 100,
+  '$app still 100';
+
+done_testing();