From: Graham Knop <haarg@haarg.org>
Date: Tue, 27 Aug 2013 16:12:03 +0000 (-0400)
Subject: Partially revert "remove mechanism for specifying superclass in _constructor_maker_for"
X-Git-Tag: v1.003001~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4ae155a9c590216ff7ac2965b3956079574c0e97;p=gitmo%2FMoo.git

Partially revert "remove mechanism for specifying superclass in _constructor_maker_for"

This partially reverts commit 8dee08c10f9b63372dff89d38b37b175cdda4489.

Re-add the mechanism for specifying superclass, but only use it when we
know it is accurate.
---

diff --git a/lib/Moo.pm b/lib/Moo.pm
index cafeed7..f5737fd 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -141,27 +141,32 @@ sub _accessor_maker_for {
 }
 
 sub _constructor_maker_for {
-  my ($class, $target) = @_;
+  my ($class, $target, $select_super) = @_;
   return unless $MAKERS{$target};
   $MAKERS{$target}{constructor} ||= do {
     require Method::Generate::Constructor;
     require Sub::Defer;
     my ($moo_constructor, $con);
 
-    my $t_new = $target->can('new');
-    if ($t_new) {
-      if ($t_new == Moo::Object->can('new')) {
-        $moo_constructor = 1;
-      } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) {
-        my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
-        if ($MAKERS{$pkg}) {
+    if ($select_super && $MAKERS{$select_super}) {
+      $moo_constructor = 1;
+      $con = $MAKERS{$select_super}{constructor};
+    } else {
+      my $t_new = $target->can('new');
+      if ($t_new) {
+        if ($t_new == Moo::Object->can('new')) {
           $moo_constructor = 1;
-          $con = $MAKERS{$pkg}{constructor};
+        } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) {
+          my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
+          if ($MAKERS{$pkg}) {
+            $moo_constructor = 1;
+            $con = $MAKERS{$pkg}{constructor};
+          }
         }
+      } else {
+        $moo_constructor = 1; # no other constructor, make a Moo one
       }
-    } else {
-      $moo_constructor = 1; # no other constructor, make a Moo one
-    }
+    };
     ($con ? ref($con) : 'Method::Generate::Constructor')
       ->new(
         package => $target,