From: Dave Rolsky <autarch@urth.org>
Date: Thu, 4 Dec 2008 22:22:58 +0000 (+0000)
Subject: Add an attribute to CMOP::Immutable, inlined_constructor, which will
X-Git-Tag: 0.71_02~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c1809cb18c9ffb1f6fbb152bf546aca88647172b;p=gitmo%2FClass-MOP.git

Add an attribute to CMOP::Immutable, inlined_constructor, which will
be used by Moose::Meta::Method::Constructor.
---

diff --git a/Changes b/Changes
index 25453e1..b9fdc95 100644
--- a/Changes
+++ b/Changes
@@ -20,6 +20,9 @@ Revision history for Perl extension Class-MOP.
       - Make the behaviour of of get_all_package_symbols (and
         therefore get_method_map) consistent for stub methods. Report
         and test by Goro Fuji (rt.cpan.org #41255). (Florian Ragwitz)
+    * Class::MOP::Immutable
+      - Added a new attribute, inlined_constructor, which is true if
+        the constructor was inlined.
 
 0.71 Wed November 26, 2008
     * Class::MOP::Class
diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm
index 542c850..bde41f7 100644
--- a/lib/Class/MOP/Immutable.pm
+++ b/lib/Class/MOP/Immutable.pm
@@ -36,6 +36,7 @@ sub new {
         'metaclass'           => $metaclass,
         'options'             => $options,
         'immutable_metaclass' => undef,
+        'inlined_constructor' => 0,
     );
 
     return $self;
@@ -58,6 +59,7 @@ sub immutable_metaclass {
 
 sub metaclass           { (shift)->{'metaclass'}           }
 sub options             { (shift)->{'options'}             }
+sub inlined_constructor { (shift)->{'inlined_constructor'} }
 
 sub create_immutable_metaclass {
     my $self = shift;
@@ -155,8 +157,10 @@ sub _inline_constructor {
         name         => $options->{constructor_name},
     );
 
-    $metaclass->add_method( $options->{constructor_name} => $constructor )
-        if $options->{replace_constructor} or $constructor->can_be_inlined;
+    if ( $options->{replace_constructor} or $constructor->can_be_inlined ) {
+        $metaclass->add_method( $options->{constructor_name} => $constructor );
+        $self->{inlined_constructor} = 1;
+    }
 }
 
 sub _inline_destructor {
@@ -357,8 +361,11 @@ sub make_metaclass_mutable {
     # 14:27 <@stevan> so I am not worried
     if ($options{inline_constructor}  && $immutable->has_method($options{constructor_name})) {
         my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
-        $immutable->remove_method( $options{constructor_name}  )
-          if blessed($immutable->get_method($options{constructor_name})) eq $constructor_class;
+
+        if ( blessed($immutable->get_method($options{constructor_name})) eq $constructor_class ) {
+            $immutable->remove_method( $options{constructor_name}  );
+            $self->{inlined_constructor} = 0;
+        }
     }
 }
 
@@ -455,6 +462,8 @@ This will change the C<$metaclass> into the mutable version by reversing
 the immutable process. C<%options> should be the same options that were
 given to make_metaclass_immutable.
 
+=item B<inlined_constructor>
+
 =back
 
 =head1 AUTHORS
diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t
index 5d199af..42338ac 100644
--- a/t/070_immutable_metaclass.t
+++ b/t/070_immutable_metaclass.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 84;
+use Test::More tests => 86;
 use Test::Exception;
 
 use Class::MOP;
@@ -49,6 +49,7 @@ use Class::MOP;
 
   my $immutable_metaclass = $transformer->immutable_metaclass;
   is($transformer->metaclass, $meta,      '... transformer has correct metaclass');
+  ok(!$transformer->inlined_constructor,  '... transformer says it did not inline the constructor');
   ok($immutable_metaclass->is_anon_class, '... immutable_metaclass is an anonymous class');
 
   #I don't understand why i need to ->meta here...
@@ -81,6 +82,7 @@ use Class::MOP;
         $meta->make_immutable();
     } '... changed Foo to be immutable';
 
+    ok($transformer->inlined_constructor,  '... transformer says it did inline the constructor');
     is($transformer, $meta->get_immutable_transformer, '... immutable transformer cache works');
     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 
diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t
index bbf5204..1cc9311 100644
--- a/t/073_make_mutable.t
+++ b/t/073_make_mutable.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 111;
+use Test::More tests => 113;
 use Test::Exception;
 
 use Scalar::Util;
@@ -51,6 +51,8 @@ use Class::MOP;
     ok(!$meta->make_immutable,          '... make immutable now returns nothing');
     ok($meta->get_method_map->{new},    '... inlined constructor created');
     ok($meta->has_method('new'),        '... inlined constructor created for sure');    
+    ok($meta->get_immutable_transformer->inlined_constructor,
+       '... transformer says it did inline the constructor');
 
     lives_ok { $meta->make_mutable; }  '... changed Baz to be mutable';
     ok($meta->is_mutable,               '... our class is mutable');
@@ -58,6 +60,8 @@ use Class::MOP;
     ok(!$meta->make_mutable,            '... make mutable now returns nothing');
     ok(!$meta->get_method_map->{new},   '... inlined constructor removed');
     ok(!$meta->has_method('new'),        '... inlined constructor removed for sure');    
+    ok(!$meta->get_immutable_transformer->inlined_constructor,
+       '... transformer says it did not inline the constructor');
 
     my @new_keys = sort grep { !/^_/ } keys %$meta;
     is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys');