From: Dave Rolsky Date: Fri, 11 Sep 2009 18:41:54 +0000 (-0500) Subject: Lots of fixes to object destruction. X-Git-Tag: 0.90~46 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b288593e2645b63d85032aba905744a6ba165758;p=gitmo%2FMoose.git Lots of fixes to object destruction. $@ is now always localized, but errors in DEMOLISH are always rethrown. $? is always localized in DESTROY There are tests for the in_global_destruction flag for immutabilized classes, this was not being passed previously. Added more docs on object destruction, mostly on error handling. --- diff --git a/Changes b/Changes index 060539a..0808145 100644 --- a/Changes +++ b/Changes @@ -10,9 +10,17 @@ Next declaration for all Native Traits. (Dave Rolsky) * Moose::Object - - DEMOLISH now localizes all of Perl's global status variables (worst - Perl feature evah?). Based on a patch from zefream. RT #48271. (doy - and Dave Rolsky) + - DEMOLISHALL behavior has changed. If any DEMOLISH method dies, we make + sure to rethrow its error message. However, we also localize $@ before + this so that if all the DEMOLISH methods success, the value of $@ will + be preserved. (nothingmuch and Dave Rolsky) + - We now also localize $? during object destruction. (nothingmuch and + Dave Rolsky) + - The handling of DEMOLISH methods was broken for immutablized classes, + which were not receiving the value of + Devel::GlobalDestruction::in_global_destruction. + - These two fixes address some of RT #48271, reported by Zefram. + - This is all now documented in Moose::Manual::Construction. 0.89_02 Thu, Sep 10, 2009 * Moose::Meta::Attribute::Native diff --git a/lib/Moose/Manual/Construction.pod b/lib/Moose/Manual/Construction.pod index be2d3e2..60e7cfb 100644 --- a/lib/Moose/Manual/Construction.pod +++ b/lib/Moose/Manual/Construction.pod @@ -123,9 +123,29 @@ $self->SUPER::DEMOLISH >>. Moose will arrange for all of the C methods in your hierarchy to be called, from most to least specific. +Each C method is called with a single argument. + In most cases, Perl's built-in garbage collection is sufficient, and you won't need to provide a C method. +=head2 Error Handling During Destruction + +The interaction of object destruction and Perl's global C<$@> and C<$?> +variables can be very confusing. + +Moose always localizes C<$?> when an object is being destroyed. This means +that if you explicitly call C, that exit code will be preserved even if +an object's destructor makes a system call. + +Moose also preserves C<$@> against any C calls that may happen during +object destruction. However, if an object's C method actually dies, +Moose explicitly rethrows that error. + +If you do not like this behavior, you will have to provide your own C +method and use that instead of the one provided by L. You can +do this to preserve C<$@> I capture any errors from object destruction by +creating an error stack. + =head1 AUTHOR Dave Rolsky Eautarch@urth.orgE diff --git a/lib/Moose/Meta/Method/Destructor.pm b/lib/Moose/Meta/Method/Destructor.pm index 1fce623..ab8d1f3 100644 --- a/lib/Moose/Meta/Method/Destructor.pm +++ b/lib/Moose/Meta/Method/Destructor.pm @@ -4,7 +4,9 @@ package Moose::Meta::Method::Destructor; use strict; use warnings; +use Devel::GlobalDestruction (); use Scalar::Util 'blessed', 'weaken'; +use Try::Tiny (); our $VERSION = '0.89_02'; $VERSION = eval $VERSION; @@ -81,14 +83,22 @@ sub _initialize_body { my $source; if ( @DEMOLISH_methods ) { $source = 'sub {'; - $source .= 'local ( $., $@, $!, $^E, $? );' . "\n"; + $source .= 'my $self = shift;' . "\n"; - $source - .= join ";\n" => - map { '$_[0]->' . $_->{class} . '::DEMOLISH()' } - @DEMOLISH_methods; + $source .= 'local $?;' . "\n"; - $source .= ";\n" . '}'; + $source .= 'my $in_global_destruction = Devel::GlobalDestruction::in_global_destruction;' . "\n"; + + $source .= 'Try::Tiny::try {' . "\n"; + + $source .= '$self->' . $_->{class} . '::DEMOLISH($in_global_destruction);' . "\n" + for @DEMOLISH_methods; + + $source .= '}'; + $source .= q[ Try::Tiny::catch { no warnings 'misc'; die $_ };] . "\n"; + $source .= 'return;' . "\n"; + + $source .= '}'; } else { $source = 'sub { }'; } diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index fefdfe3..8187642 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -7,6 +7,7 @@ use warnings; use Devel::GlobalDestruction qw(in_global_destruction); use MRO::Compat; use Scalar::Util; +use Try::Tiny; use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class'; use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class'; @@ -86,8 +87,20 @@ sub DEMOLISHALL { } sub DESTROY { - local ( $., $@, $!, $^E, $? ); - $_[0]->DEMOLISHALL(in_global_destruction); + my $self = shift; + + local $?; + + try { + $self->DEMOLISHALL(in_global_destruction); + } + catch { + # Without this, Perl will warn "\t(in cleanup)$@" because of some + # bizarre fucked-up logic deep in the internals. + no warnings 'misc'; + die $_; + }; + return; } diff --git a/t/010_basics/020-global-destruction-helper.pl b/t/010_basics/020-global-destruction-helper.pl index 66abaef..a5b75c6 100644 --- a/t/010_basics/020-global-destruction-helper.pl +++ b/t/010_basics/020-global-destruction-helper.pl @@ -16,4 +16,19 @@ use warnings; } } +{ + package Bar; + use Moose; + + sub DEMOLISH { + my $self = shift; + my ($igd) = @_; + + print $igd; + } + + __PACKAGE__->meta->make_immutable; +} + our $foo = Foo->new; +our $bar = Bar->new; diff --git a/t/010_basics/020-global-destruction.t b/t/010_basics/020-global-destruction.t index a20ee08..79ee4d3 100644 --- a/t/010_basics/020-global-destruction.t +++ b/t/010_basics/020-global-destruction.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 2; +use Test::More tests => 4; { package Foo; @@ -23,6 +23,28 @@ use Test::More tests => 2; my $foo = Foo->new; } -my $igd = `$^X t/010_basics/020-global-destruction-helper.pl`; -ok( $igd, - 'in_global_destruction state is passed to DEMOLISH properly (true)' ); +{ + package Bar; + use Moose; + + sub DEMOLISH { + my $self = shift; + my ($igd) = @_; + ::ok( + !$igd, + 'in_global_destruction state is passed to DEMOLISH properly (false)' + ); + } + + __PACKAGE__->meta->make_immutable; +} + +{ + my $bar = Bar->new; +} + +ok( + $_, + 'in_global_destruction state is passed to DEMOLISH properly (true)' +) for split //, `$^X t/010_basics/020-global-destruction-helper.pl`; + diff --git a/t/100_bugs/012_DEMOLISH_eats_mini.t b/t/100_bugs/012_DEMOLISH_eats_mini.t index 1ba9f47..27ac51f 100644 --- a/t/100_bugs/012_DEMOLISH_eats_mini.t +++ b/t/100_bugs/012_DEMOLISH_eats_mini.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 10; +use Test::More tests => 12; use Test::Exception; @@ -51,26 +51,50 @@ use Test::Exception; use Moose; sub DEMOLISH { - $@ = 1; $? = 0; - $! = 0; } } { + local $@ = 42; + local $? = 84; + + { + Baz->new; + } + + is( $@, 42, '$@ is still 42 after object is demolished without dying' ); + is( $?, 84, '$? is still 84 after object is demolished without dying' ); + local $@ = 0; - local $? = 42; - local $! = 84; { Baz->new; } - is( $@, 0, '$@ is still 0 after object is demolished' ); - is( $?, 42, '$? is still 42 after object is demolished' ); - is( $! + 0, 84, '$! is still 84 after object is demolished' ); + is( $@, 0, '$@ is still 0 after object is demolished without dying' ); Baz->meta->make_immutable, redo if Baz->meta->is_mutable } +{ + package Quux; + use Moose; + + sub DEMOLISH { + die "foo\n"; + } +} + +{ + local $@ = 42; + + eval { my $obj = Quux->new }; + + like( $@, qr/foo/, '$@ contains error from demolish when demolish dies' ); + + Quux->meta->make_immutable, redo + if Quux->meta->is_mutable +} +