From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sun, 19 Apr 2009 13:36:57 +0000 (+0200)
Subject: Update for removal of immutable transformer
X-Git-Tag: 0.75_01~13^2~5^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0fa70d03f16f7932e345e35caa8f0fca009242e4;p=gitmo%2FMoose.git

Update for removal of immutable transformer
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 94459f2..2114286 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -18,6 +18,9 @@ our $AUTHORITY = 'cpan:STEVAN';
 use Moose::Meta::Method::Overridden;
 use Moose::Meta::Method::Augmented;
 use Moose::Error::Default;
+use Moose::Meta::Class::Immutable::Trait;
+use Moose::Meta::Method::Constructor;
+use Moose::Meta::Method::Destructor;
 
 use base 'Class::MOP::Class';
 
@@ -26,6 +29,14 @@ __PACKAGE__->meta->add_attribute('roles' => (
     default => sub { [] }
 ));
 
+
+__PACKAGE__->meta->add_attribute(
+    Class::MOP::Attribute->new('immutable_trait' => (
+        accessor => "immutable_trait",
+        default  => 'Moose::Meta::Class::Immutable::Trait',
+    ))
+);
+
 __PACKAGE__->meta->add_attribute('constructor_class' => (
     accessor => 'constructor_class',
     default  => 'Moose::Meta::Method::Constructor',
@@ -41,7 +52,6 @@ __PACKAGE__->meta->add_attribute('error_class' => (
     default  => 'Moose::Error::Default',
 ));
 
-
 sub initialize {
     my $class = shift;
     my $pkg   = shift;
@@ -54,6 +64,19 @@ sub initialize {
             );    
 }
 
+sub _immutable_options {
+    my ( $self, @args ) = @_;
+
+    $self->SUPER::_immutable_options(
+        inline_destructor => 1,
+
+        # Moose always does this when an attribute is created
+        inline_accessors => 0,
+
+        @args,
+    );
+}
+
 sub create {
     my ($self, $package_name, %options) = @_;
     
@@ -537,36 +560,6 @@ sub _process_inherited_attribute {
 
 ## -------------------------------------------------
 
-use Moose::Meta::Method::Constructor;
-use Moose::Meta::Method::Destructor;
-
-
-sub _default_immutable_transformer_options {
-    my $self = shift;
-
-    my %options = $self->SUPER::_default_immutable_transformer_options;
-
-    # We need to copy the references as we do not want to alter the
-    # superclass's references.
-    $options{cannot_call} = [ @{ $options{cannot_call} }, 'add_role' ];
-    $options{memoize} = {
-        %{ $options{memoize} },
-        calculate_all_roles => 'ARRAY',
-    };
-
-    %options = (
-        %options,
-        constructor_class => $self->constructor_class,
-        destructor_class  => $self->destructor_class,
-        inline_destructor => 1,
-
-        # Moose always does this when an attribute is created
-        inline_accessors => 0,
-    );
-
-    return %options
-}
-
 our $error_level;
 
 sub throw_error {
diff --git a/lib/Moose/Meta/Class/Immutable/Trait.pm b/lib/Moose/Meta/Class/Immutable/Trait.pm
new file mode 100644
index 0000000..a570c52
--- /dev/null
+++ b/lib/Moose/Meta/Class/Immutable/Trait.pm
@@ -0,0 +1,14 @@
+package Moose::Meta::Class::Immutable::Trait;
+
+use strict;
+use warnings;
+
+use Class::MOP;
+
+use base 'Class::MOP::Class::Immutable::Trait';
+
+sub add_role { shift->_immutable_cannot_call }
+
+sub calculate_all_roles { @{ $_[0]{__immutable}{calculate_all_roles} ||= [ shift->next::method ] } }
+
+1;
diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 306a5c1..ca389e3 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -4,7 +4,7 @@ package Moose::Meta::Method::Constructor;
 use strict;
 use warnings;
 
-use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
+use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
 
 our $VERSION   = '0.74';
 our $AUTHORITY = 'cpan:STEVAN';
@@ -30,6 +30,7 @@ sub new {
         'name'          => $options{name},
         'options'       => $options{options},
         'associated_metaclass' => $meta,
+        '_expected_method_class' => $options{_expected_method_class} || 'Moose::Object',
     } => $class;
 
     # we don't want this creating
@@ -42,62 +43,6 @@ sub new {
     return $self;
 }
 
-sub can_be_inlined {
-    my $self      = shift;
-    my $metaclass = $self->associated_metaclass;
-
-    my $expected_class = $self->_expected_constructor_class;
-
-    # If any of our parents have been made immutable, we are okay to
-    # inline our own new method. The assumption is that an inlined new
-    # method provided by a parent does not actually get used by
-    # children anyway.
-    for my $meta (
-        grep { $_->is_immutable }
-        map  { ( ref $metaclass )->initialize($_) }
-        grep { $_ ne $expected_class }
-        $metaclass->linearized_isa
-        ) {
-        my $transformer = $meta->immutable_transformer;
-
-        # This is actually a false positive if we're in a subclass of
-        # this class, _and_ the expected class is not overridden (but
-        # should be), and the real expected class is actually
-        # immutable itself (see Fey::Object::Table for an example of
-        # how this can happen). I'm not sure how to actually handle
-        # that case, since it's effectively a bug in the subclass (for
-        # not overriding _expected_constructor_class).
-        return 1 if $transformer->inlined_constructor;
-    }
-
-    if ( my $constructor = $metaclass->find_method_by_name( $self->name ) ) {
-        my $class = $self->associated_metaclass->name;
-
-        if ( $constructor->body != $expected_class->can('new') ) {
-            my $warning
-                = "Not inlining a constructor for $class since it is not"
-                . " inheriting the default $expected_class constructor\n"
-                . "If you are certain you don't need to inline your"
-                . " constructor, specify inline_constructor => 0 in your"
-                . " call to $class->meta->make_immutable\n";
-
-            $warning .= " (constructor has method modifiers which would be lost if it were inlined)\n"
-                if $constructor->isa('Class::MOP::Method::Wrapped');
-
-            warn $warning;
-
-            return 0;
-        }
-        else {
-            return 1;
-        }
-    }
-
-    # This would be a rather weird case where we have no constructor
-    # in the inheritance chain.
-    return 1;
-}
-
 # This is here so can_be_inlined can be inherited by MooseX modules.
 sub _expected_constructor_class {
     return 'Moose::Object';
diff --git a/t/300_immutable/010_constructor_is_not_moose.t b/t/300_immutable/010_constructor_is_not_moose.t
index 1288555..8a8cb8d 100644
--- a/t/300_immutable/010_constructor_is_not_moose.t
+++ b/t/300_immutable/010_constructor_is_not_moose.t
@@ -26,9 +26,11 @@ plan tests => 6;
 
     extends 'NotMoose';
 
+    warn "oi";
+
     ::stderr_is(
         sub { Foo->meta->make_immutable },
-        "Not inlining a constructor for Foo since it is not inheriting the default Moose::Object constructor\nIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable\n",
+        "Not inlining 'new' for Foo since it is not inheriting the default Moose::Object::new\nIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable\n",
         'got a warning that Foo may not have an inlined constructor'
     );
 }
diff --git a/t/300_immutable/011_constructor_is_wrapped.t b/t/300_immutable/011_constructor_is_wrapped.t
index 099f200..f7f71b2 100644
--- a/t/300_immutable/011_constructor_is_wrapped.t
+++ b/t/300_immutable/011_constructor_is_wrapped.t
@@ -25,7 +25,7 @@ plan tests => 1;
 
     ::stderr_is(
         sub { Foo->meta->make_immutable },
-        "Not inlining a constructor for Foo since it is not inheriting the default Moose::Object constructor\nIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable\n (constructor has method modifiers which would be lost if it were inlined)\n",
+        "Not inlining 'new' for Foo since it is not inheriting the default Moose::Object::new\nIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable\n ('new' has method modifiers which would be lost if it were inlined)\n",
         'got a warning that Foo may not have an inlined constructor'
     );
 }
diff --git a/t/600_todo_tests/003_immutable_n_around.t b/t/600_todo_tests/003_immutable_n_around.t
index 8c47b56..3f09630 100644
--- a/t/600_todo_tests/003_immutable_n_around.t
+++ b/t/600_todo_tests/003_immutable_n_around.t
@@ -42,7 +42,6 @@ tests: {
  TODO: {
     is( Foo->new->foo, undef, "base class (" . (Foo->meta->is_immutable ? "immutable" : "mutable") . ")" );
     is( Bar->new->foo, 42, "around new called on Bar->new (" . (Bar->meta->is_immutable ? "immutable" : "mutable") . ")"  );
-    local $TODO = 'these tests fail once Gorch is immutable' if Gorch->meta->is_immutable;
     is( Gorch->new->foo, 42, "around new called on Gorch->new (" . (Gorch->meta->is_immutable ? "immutable" : "mutable") . ")"  );
     is( Zoink->new->foo, 42, "around new called Zoink->new (" . (Zoink->meta->is_immutable ? "immutable" : "mutable") . ")"  );
     }