From: Tokuhiro Matsuno <tokuhirom@gp.ath.cx>
Date: Wed, 3 Dec 2008 03:52:14 +0000 (+0000)
Subject: generate DESTROY method for performance improvement
X-Git-Tag: 0.19~136^2~70
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=bbf64e76e08d76a06b35685f878fda243abc87c2

generate DESTROY method for performance improvement
---

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 67d012e..3808291 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use Mouse::Meta::Method::Constructor;
+use Mouse::Meta::Method::Destructor;
 use Mouse::Util qw/get_linear_isa blessed/;
 use Carp 'confess';
 
@@ -143,7 +144,8 @@ sub make_immutable {
     my $name = $self->name;
     $self->{is_immutable}++;
     no strict 'refs';
-    *{"$name\::new"} = Mouse::Meta::Method::Constructor->generate_constructor_method_inline( $self );
+    *{"$name\::new"}     = Mouse::Meta::Method::Constructor->generate_constructor_method_inline( $self );
+    *{"$name\::DESTROY"} = Mouse::Meta::Method::Destructor->generate_destructor_method_inline( $self );
 }
 sub make_mutable {
     Carp::croak "Mouse::Meta::Class->make_mutable does not supported by Mouse";
diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm
new file mode 100644
index 0000000..623e7d7
--- /dev/null
+++ b/lib/Mouse/Meta/Method/Destructor.pm
@@ -0,0 +1,37 @@
+package Mouse::Meta::Method::Destructor;
+use strict;
+use warnings;
+
+sub generate_destructor_method_inline {
+    my ($class, $meta) = @_;
+
+    my $demolishall = do {
+        if ($meta->name->can('DEMOLISH')) {
+            my @code = ();
+            no strict 'refs';
+            for my $klass ($meta->linearized_isa) {
+                if (*{$klass . '::DEMOLISH'}{CODE}) {
+                    push @code, "${klass}::DEMOLISH(\$self);";
+                }
+            }
+            join "\n", @code;
+        } else {
+            ''; # no demolish =)
+        }
+    };
+
+    my $code = <<"...";
+    sub {
+        my \$self = shift;
+        $demolishall;
+    }
+...
+    warn $code if $ENV{DEBUG};
+
+    local $@;
+    my $res = eval $code;
+    die $@ if $@;
+    $res;
+}
+
+1;
diff --git a/t/804-immutable-demolish.t b/t/804-immutable-demolish.t
new file mode 100644
index 0000000..38917e7
--- /dev/null
+++ b/t/804-immutable-demolish.t
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+use t::Exception;
+
+my $i;
+
+{
+    package Parent;
+    use Mouse;
+    sub DEMOLISH {
+        main::is $i++, 1;
+    }
+    no Mouse;
+    __PACKAGE__->meta->make_immutable;
+}
+
+{
+    package Child;
+    use Mouse;
+    extends 'Parent';
+    sub DEMOLISH {
+        main::is $i++, 0;
+    }
+    __PACKAGE__->meta->make_immutable;
+}
+
+Child->new();
+