From: Dave Rolsky <autarch@urth.org>
Date: Thu, 4 Dec 2008 23:00:05 +0000 (+0000)
Subject: Make sure that whenever we don't inline, we warn, and add tests.
X-Git-Tag: 0.62_02~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=db058da6e431dfe40f573dbdb47b7229f1b1afa7;p=gitmo%2FMoose.git

Make sure that whenever we don't inline, we warn, and add tests.
---

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 4873c8b..3ef9fad 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -51,6 +51,8 @@ sub can_be_inlined {
     my $self      = shift;
     my $metaclass = $self->associated_metaclass;
 
+    my $class = $self->associated_metaclass->name;
+
     # If any of our parents have been made immutable, we are okay to
     # inline our own method as long as the parent's constructor class
     # is the same as $self.
@@ -62,7 +64,22 @@ sub can_be_inlined {
         my $constructor = $transformer->inlined_constructor
             or next;
 
-        return ref $constructor eq ref $self;
+        return 1 if ref $constructor eq ref $self;
+
+        my $parent_name = $meta->name;
+        my $constructor_class = ref $constructor;
+        my $self_class = ref $self;
+
+        # This case is fairly unlikely. In most normal cases,
+        # incompatibility between constructor classes will be caught
+        # by the code that fixes metaclass incompatibility in
+        # Moose::Meta::Class. However, if the parent passes a
+        # constructor_class directly to
+        # Parent->meta->make_immutable(), this could happen.
+        warn "Not inlining a constructor for $class. It has a parent class ($parent_name)"
+            . " which was inlined using $constructor_class, but $class is using $self_class\n";
+
+        return 0;
     }
 
     if ( my $constructor = $metaclass->find_method_by_name( $self->name ) ) {
@@ -70,7 +87,6 @@ sub can_be_inlined {
         my $expected_class = $self->_expected_constructor_class;
 
         if ( $constructor->body != $expected_class->can('new') ) {
-            my $class = $metaclass->name;
             warn "Not inlining a constructor for $class since it is not"
                 . " inheriting the default $expected_class constructor\n";
 
diff --git a/t/300_immutable/010_constructor_is_not_moose.t b/t/300_immutable/010_constructor_is_not_moose.t
index 2a03b24..72e1b7a 100644
--- a/t/300_immutable/010_constructor_is_not_moose.t
+++ b/t/300_immutable/010_constructor_is_not_moose.t
@@ -8,7 +8,7 @@ use Test::More;
 eval "use Test::Output";
 plan skip_all => "Test::Output is required for this test" if $@;
 
-plan tests => 5;
+plan tests => 6;
 
 {
     package NotMoose;
@@ -77,3 +77,28 @@ isnt(
         'no warning when inheriting from a class that has already made itself immutable'
     );
 }
+
+{
+    package My::Constructor;
+    use base 'Moose::Meta::Method::Constructor';
+}
+
+{
+    package CustomCons;
+    use Moose;
+
+    CustomCons->meta->make_immutable( constructor_class => 'My::Constructor' );
+}
+
+{
+    package Subclass;
+    use Moose;
+
+    extends 'CustomCons';
+
+    ::stderr_is(
+        sub { Subclass->meta->make_immutable },
+        "Not inlining a constructor for Subclass. It has a parent class (CustomCons) which was inlined using My::Constructor, but Subclass is using Moose::Meta::Method::Constructor\n",
+        'no warning when inheriting from a class that has already made itself immutable'
+    );
+}