From: Matt S Trout 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;