From: Matt S Trout <mst@shadowcat.co.uk>
Date: Thu, 25 Aug 2011 23:44:42 +0000 (+0000)
Subject: Tenative switch to a generated DEMOLISHALL - see rest of message for caveats
X-Git-Tag: v0.009011~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=56ffe19d51215674fb162c30ba9c5dc1951402c5;p=gitmo%2FRole-Tiny.git

Tenative switch to a generated DEMOLISHALL - see rest of message for caveats

I'm wondering if the reason that ajgb didn't do it this way is that it has
bad interactions with global destruction on some perls; it did, however, work
fine in the t/ cases. Rather than use the ugly "let's figure this out every
time" code that he wrote (which did, admittedly, work) I think that if the
generation doesn't work across perls then our best path forwards is to try
and accelerate DEMOLISHALL construction - perhaps even lifting it to new()
time so that classes without a DEMOLISH method don't get a DESTROY added (I
hate having to always have a DESTROY method).

But first, I want to see if this breaks so that I know how to test that
lifting to new() time fixes it.
---

diff --git a/lib/Method/Generate/DemolishAll.pm b/lib/Method/Generate/DemolishAll.pm
new file mode 100644
index 0000000..0126680
--- /dev/null
+++ b/lib/Method/Generate/DemolishAll.pm
@@ -0,0 +1,34 @@
+package Method::Generate::DemolishAll;
+
+use strictures 1;
+use base qw(Moo::Object);
+use Sub::Quote;
+use Moo::_Utils;
+use B qw(perlstring);
+
+sub generate_method {
+  my ($self, $into) = @_;
+  quote_sub "${into}::DEMOLISHALL", join '',
+    $self->_handle_subdemolish($into),
+    qq{    my \$self = shift;\n},
+    $self->demolishall_body_for($into, '$self', '@_'),
+    qq{    return \$self\n};
+}
+
+sub demolishall_body_for {
+  my ($self, $into, $me, $args) = @_;
+  my @demolishers =
+    grep *{_getglob($_)}{CODE},
+    map "${_}::DEMOLISH",
+    @{Moo::_Utils::_get_linear_isa($into)};
+  join '', map qq{    ${me}->${_}(${args});\n}, @demolishers;
+}
+
+sub _handle_subdemolish {
+  my ($self, $into) = @_;
+  '    if (ref($_[0]) ne '.perlstring($into).') {'."\n".
+  '      return shift->Moo::Object::DEMOLISHALL(@_)'.";\n".
+  '    }'."\n";
+}
+
+1;
diff --git a/lib/Moo/Object.pm b/lib/Moo/Object.pm
index 1b26821..06a86f9 100644
--- a/lib/Moo/Object.pm
+++ b/lib/Moo/Object.pm
@@ -4,6 +4,7 @@ use strictures 1;
 
 our %NO_BUILD;
 our $BUILD_MAKER;
+our $DEMOLISH_MAKER;
 
 sub new {
   my $class = shift;
@@ -58,16 +59,7 @@ sub DESTROY {
         eval {
             # DEMOLISHALL
 
-            # We cannot count on being able to retrieve a previously made
-            # metaclass, _or_ being able to make a new one during global
-            # destruction. However, we should still be able to use mro at
-            # that time (at least tests suggest so ;)
-
-            foreach my $class (@{ Moo::_Utils::_get_linear_isa(ref $self) }) {
-                my $demolish = $class->can('DEMOLISH') || next;
-
-                $self->$demolish($Moo::_Utils::_in_global_destruction);
-            }
+            $self->DEMOLISHALL($Moo::_Utils::_in_global_destruction);
         };
         $@;
     };
@@ -76,7 +68,13 @@ sub DESTROY {
     die $e if $e; # rethrow
 }
 
-
+sub DEMOLISHALL {
+  my $self = shift;
+  $self->${\(($DEMOLISH_MAKER ||= do {
+    require Method::Generate::DemolishAll;
+    Method::Generate::DemolishAll->new
+  })->generate_method(ref($self)))}(@_);
+}
 
 sub does {
   require Role::Tiny;