More global destruction fixes.

The existing global destruction tests were not happy on Win32. This is
based on a patch from Robert Krimen, but is greatly simplified by
making sure the only test output we provide is from the .t file,
rather than mixing it between the .t and the helper script.

This also changes how we loop through the ancestors for a class in
DEMOLISH. I was seeing failures on 5.8.8 that happened when the
metaclass object had been garbage collected and we tried to make a new
one. Making a new one failed because the meta-attribute objects for
Moose::Meta::Class itself had also been garbage collected!

This is a hack to avoid the meta-API entirely during destruction.

diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index ecf874a..6c5ffdf 100644 (file)
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -4,8 +4,9 @@ package Moose::Object;
 use strict;
 use warnings;
 
-use Scalar::Util;
 use Devel::GlobalDestruction qw(in_global_destruction);
+use MRO::Compat;
+use Scalar::Util;
 
 use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class';
 use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
@@ -64,17 +65,12 @@ sub DEMOLISHALL {
     # extra meta level calls
     return unless $self->can('DEMOLISH');
 
-    # This is a hack, because Moose::Meta::Class may not be the right
-    # metaclass, but class_of may return undef during global
-    # destruction, if the metaclass object has already been cleaned
-    # up.
-    my $meta = Class::MOP::class_of($self)
-        || Moose::Meta::Class->initialize( ref $self );
-
-    # can't just use find_all_methods_by_name here because during global
-    # destruction, the method meta-object may have already been
-    # destroyed
-    foreach my $class ( $meta->linearized_isa ) {
+    # 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 ;)
+    my $class_name = ref $self;
+    foreach my $class ( @{ mro::get_linear_isa($class_name) } ) {
         no strict 'refs';
         my $demolish = *{"${class}::DEMOLISH"}{CODE};
         $self->$demolish($in_global_destruction)

diff --git a/t/010_basics/020-global-destruction-helper.pl b/t/010_basics/020-global-destruction-helper.pl
new file mode 100644 (file)
index 0000000..66abaef
--- /dev/null
+++ b/t/010_basics/020-global-destruction-helper.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+{
+    package Foo;
+    use Moose;
+
+    sub DEMOLISH {
+        my $self = shift;
+        my ($igd) = @_;
+
+        print $igd;
+    }
+}
+
+our $foo = Foo->new;

diff --git a/t/010_basics/020-global-destruction.t b/t/010_basics/020-global-destruction.t
index f4b6877..a20ee08 100644 (file)
--- a/t/010_basics/020-global-destruction.t
+++ b/t/010_basics/020-global-destruction.t
@@ -5,30 +5,24 @@ use warnings;
 
 use Test::More tests => 2;
 
-our $expected_igd = 0;
-package Foo;
-use Moose;
+{
+    package Foo;
+    use Moose;
 
-sub DEMOLISH {
-    my $self = shift;
-    my ($igd) = @_;
-    ::is($igd, $::expected_igd,
-         "in_global_destruction state is passed to DEMOLISH properly");
+    sub DEMOLISH {
+        my $self = shift;
+        my ($igd) = @_;
+        ::ok(
+            !$igd,
+            'in_global_destruction state is passed to DEMOLISH properly (false)'
+        );
+    }
 }
 
-package main;
 {
     my $foo = Foo->new;
 }
-$expected_igd = 1;
-# Test::Builder checks for a valid plan at END time, which is before global
-# destruction, so need to test that in a subprocess
-unless (fork) {
-    our $foo = Foo->new;
-    exit;
-}
-wait;
-# but stuff that happens in a subprocess doesn't update Test::Builder's state
-# in this process, so do that manually here
-my $builder = Test::More->builder;
-$builder->current_test($builder->current_test + 1);
+
+my $igd = `$^X t/010_basics/020-global-destruction-helper.pl`;
+ok( $igd,
+    'in_global_destruction state is passed to DEMOLISH properly (true)' );