X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FConstructor.pm;fp=lib%2FClass%2FMOP%2FMethod%2FConstructor.pm;h=4b590fe3db52a083322043d308a3d07206d066d4;hb=bdb2de61b65cd4b9b38d8726f25f3650e4d23677;hp=a150dcc8e5ff6aeb8a0141986c78db6d754a8bdb;hpb=d0efb39cebabfeca0833ed43ea155ce03a1556c4;p=gitmo%2FMoose.git

diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index a150dcc..4b590fe 100644
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util 'blessed', 'weaken';
+use Scalar::Util 'blessed', 'weaken', 'refaddr';
 use Try::Tiny;
 
 use base 'Class::MOP::Method::Inlined';
@@ -100,16 +100,43 @@ sub _generate_constructor_method_inline {
 
     warn join("\n", @source) if $self->options->{debug};
 
-    my $RuNNeR; my $code = bless sub { if (!defined($RuNNeR)) { $RuNNeR = try {
-        $self->_compile_code(\@source);
-    }
-    catch {
-        my $source = join("\n", @source);
-        confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$_";
-    };
-    return $RuNNeR if !defined($_[0]) && ref($_[1]) && ref($_[1]) eq 'RuNNeR'}; goto $RuNNeR},'RuNNeR';
-
-    return $code;
+    my $RuNNeR;
+    my $code;
+    return $code = bless sub {
+        if (!defined($RuNNeR)) {
+            $RuNNeR = try {
+                $self->_compile_code(\@source);
+            }
+            catch {
+                my $source = join("\n", @source);
+                confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$_";
+            };
+            # update the body member unless something else has stomped on it
+            my $body = $self->{'body'};
+            if (refaddr($code) != refaddr($body)) {
+                # we seem to be outdated... paranoid future-proofing, I think..
+                goto $RuNNeR = $body;
+            }
+            $self->{'body'} = $RuNNeR;
+            # update the symbol in the stash if it's currently immutable
+            # and it's still the original we set previously.
+        #    my $assoc_class = $self->associated_metaclass;
+        #    my $sigiled_name = '&'.$self->{'name'};
+        #    if ($assoc_class->is_immutable) {
+        #        my $stash = $assoc_class->_package_stash;
+        #        my $symbol_ref = $stash->get_symbol($sigiled_name);
+        #        if (!defined($symbol_ref)) {
+        #            confess "A metaobject is corrupted";
+        #        }
+        #        if (refaddr($code) != refaddr($symbol_ref)) {
+        #            goto $RuNNeR = $symbol_ref;
+        #        }
+        #        $stash->add_symbol($sigiled_name, $RuNNeR);
+        #    }
+        };
+        return unless defined($_[0]);
+        goto $RuNNeR;
+    },'RuNNeR';
 }
 
 1;