Lots of fixes to object destruction.
Dave Rolsky [Fri, 11 Sep 2009 18:41:54 +0000 (13:41 -0500)]
$@ 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.

Changes
lib/Moose/Manual/Construction.pod
lib/Moose/Meta/Method/Destructor.pm
lib/Moose/Object.pm
t/010_basics/020-global-destruction-helper.pl
t/010_basics/020-global-destruction.t
t/100_bugs/012_DEMOLISH_eats_mini.t

diff --git a/Changes b/Changes
index 060539a..0808145 100644 (file)
--- 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
index be2d3e2..60e7cfb 100644 (file)
@@ -123,9 +123,29 @@ $self->SUPER::DEMOLISH >>. Moose will arrange for all of the
 C<DEMOLISH> methods in your hierarchy to be called, from most to least
 specific.
 
+Each C<DEMOLISH> 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<DEMOLISH> 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<exit>, that exit code will be preserved even if
+an object's destructor makes a system call.
+
+Moose also preserves C<$@> against any C<eval> calls that may happen during
+object destruction. However, if an object's C<DEMOLISH> method actually dies,
+Moose explicitly rethrows that error.
+
+If you do not like this behavior, you will have to provide your own C<DESTROY>
+method and use that instead of the one provided by L<Moose::Object>. You can
+do this to preserve C<$@> I<and> capture any errors from object destruction by
+creating an error stack.
+
 =head1 AUTHOR
 
 Dave Rolsky E<lt>autarch@urth.orgE<gt>
index 1fce623..ab8d1f3 100644 (file)
@@ -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 { }';
     }
index fefdfe3..8187642 100644 (file)
@@ -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;
 }
 
index 66abaef..a5b75c6 100644 (file)
@@ -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;
index a20ee08..79ee4d3 100644 (file)
@@ -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`;
+
index 1ba9f47..27ac51f 100644 (file)
@@ -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
+}
+