From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 16 Apr 2012 08:27:43 +0000 (+0000)
Subject: play jenga
X-Git-Tag: v0.009_017~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7ecb13a6d8bc9323b5d07aaa2a2a5aee9fd76400;p=gitmo%2FMoo.git

play jenga
---

diff --git a/Changes b/Changes
index 594486e..95571b1 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - mangle constructor meta-method on inflation so make_immutable works
   - fix possible infinite loop caused by subconstructor code
 
 0.009_016 - 2012-04-12
diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
index f89325a..1103126 100644
--- a/lib/Moo/HandleMoose.pm
+++ b/lib/Moo/HandleMoose.pm
@@ -13,6 +13,8 @@ sub inject_all {
   require Class::MOP;
   inject_fake_metaclass_for($_) for grep $_ ne 'Moo::Object', keys %Moo::MAKERS;
   inject_fake_metaclass_for($_) for keys %Moo::Role::INFO;
+  require Moose::Meta::Method::Constructor;
+  @Moo::HandleMoose::FakeConstructor::ISA = 'Moose::Meta::Method::Constructor';
 }
 
 sub inject_fake_metaclass_for {
@@ -25,6 +27,13 @@ sub inject_fake_metaclass_for {
 
 our %DID_INJECT;
 
+{
+  package Moo::HandleMoose::FakeConstructor;
+
+  sub _uninlined_body { \&Moose::Object::new }
+}
+    
+
 sub inject_real_metaclass_for {
   my ($name) = @_;
   return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name};
@@ -74,6 +83,10 @@ sub inject_real_metaclass_for {
         $method->{body} = $name->can($method->name);
       }
     }
+    bless(
+      $meta->find_method_by_name('new'),
+      'Moo::HandleMoose::FakeConstructor',
+    );
   }
   $meta->add_role(Class::MOP::class_of($_))
     for keys %{$Role::Tiny::APPLIED_TO{$name}};
diff --git a/xt/jenga.t b/xt/jenga.t
new file mode 100644
index 0000000..7e457dd
--- /dev/null
+++ b/xt/jenga.t
@@ -0,0 +1,48 @@
+use strictures 1;
+use Test::More;
+
+{
+  package Tower1;
+
+  use Moo;
+
+  has 'attr1' => (is => 'ro', required => 1);
+
+  package Tower2;
+
+  use Moose;
+
+  extends 'Tower1';
+
+  has 'attr2' => (is => 'ro', required => 1);
+
+  __PACKAGE__->meta->make_immutable;
+
+  package Tower3;
+
+  use Moo;
+
+  extends 'Tower2';
+
+  has 'attr3' => (is => 'ro', required => 1);
+
+  package Tower4;
+
+  use Moose;
+
+  extends 'Tower3';
+
+  has 'attr4' => (is => 'ro', required => 1);
+
+  __PACKAGE__->meta->make_immutable;
+}
+
+foreach my $num (1..4) {
+  my $class = "Tower${num}";
+  my @attrs = map "attr$_", 1..$num;
+  my %args = map +($_ => "${_}_value"), @attrs;
+  my $obj = $class->new(%args);
+  is($obj->{$_}, "${_}_value", "Attribute $_ ok for $class") for @attrs;
+}
+
+done_testing;