From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 14 Apr 2012 13:09:28 +0000 (+0000)
Subject: avert horrible infinite loop
X-Git-Tag: v0.009_017~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=76ab397705b93ed85e5e82597c930e72b44d2355;p=gitmo%2FMoo.git

avert horrible infinite loop
---

diff --git a/Changes b/Changes
index 46384d4..594486e 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - fix possible infinite loop caused by subconstructor code
+
 0.009_016 - 2012-04-12
   - don't accidentally load Moo::HandleMoose during global destruction
   - better docs for trigger (and initializer's absence)
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 33e6a08..707341d 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -73,10 +73,9 @@ sub generate_method {
 
 sub _handle_subconstructor {
   my ($self, $into, $name) = @_;
-  if (my $gen = $self->{subconstructor_generator}) {
+  if (my $gen = $self->{subconstructor_handler}) {
     '    if ($class ne '.perlstring($into).') {'."\n".
-    '      '.$gen.";\n".
-    '      return $class->'.$name.'(@_)'.";\n".
+    $gen.
     '    }'."\n";
   } else {
     ''
diff --git a/lib/Moo.pm b/lib/Moo.pm
index 470e681..98bc057 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -91,8 +91,11 @@ sub _constructor_maker_for {
             ? ($con ? $con->construction_string : undef)
             : ('$class->'.$target.'::SUPER::new(@_)')
         ),
-        subconstructor_generator => (
-          $class.'->_constructor_maker_for($class,'.perlstring($target).')'
+        subconstructor_handler => (
+          '      if ($Moo::MAKERS{$class}) {'."\n"
+          .'        '.$class.'->_constructor_maker_for($class,'.perlstring($target).');'."\n"
+          .'        return $class->new(@_)'.";\n"
+          .'      }'."\n"
         ),
       )
       ->install_delayed
diff --git a/t/subconstructor.t b/t/subconstructor.t
new file mode 100644
index 0000000..edd2718
--- /dev/null
+++ b/t/subconstructor.t
@@ -0,0 +1,18 @@
+use strictures 1;
+use Test::More;
+
+{
+  package SubCon1;
+
+  use Moo;
+
+  has foo => (is => 'ro');
+
+  package SubCon2;
+
+  our @ISA = qw(SubCon1);
+}
+
+ok(SubCon2->new, 'constructor completes');
+
+done_testing;