Fix a possible segv on DESTROY

diff --git a/Changes b/Changes
index a05d904..48a9853 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 Revision history for Mouse
 
 0.50_03
+    * Mouse::Object
+        - Fix a possible segv which is caused by destructors (gfx)
     * Mouse::Util::TypeConstraints
         - Implement the built-in type hierarchy (gfx)
 

diff --git a/t/010_basics/020-global-destruction-helper.pl b/t/010_basics/020-global-destruction-helper.pl
index b6a3dc0..a690d4d 100644 (file)
--- a/t/010_basics/020-global-destruction-helper.pl
+++ b/t/010_basics/020-global-destruction-helper.pl
@@ -12,7 +12,7 @@ no warnings 'once'; # work around 5.6.2
         my $self = shift;
         my ($igd) = @_;
 
-        print $igd;
+        print $igd || 0, "\n";
     }
 }
 
@@ -24,7 +24,7 @@ no warnings 'once'; # work around 5.6.2
         my $self = shift;
         my ($igd) = @_;
 
-        print $igd;
+        print $igd || 0, "\n";
     }
 
     __PACKAGE__->meta->make_immutable;

diff --git a/t/010_basics/020-global-destruction.t b/t/010_basics/020-global-destruction.t
index 7bcecf0..42aa362 100644 (file)
--- a/t/010_basics/020-global-destruction.t
+++ b/t/010_basics/020-global-destruction.t
@@ -43,9 +43,14 @@ use Test::More;
     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`;
+$? = 0;
+
+my $blib = $INC{'blib.pm'} ? ' -Mblib ' : '';
+my @status = `$^X $blib t/010_basics/020-global-destruction-helper.pl`;
+
+ok $status[0], 'in_global_destruction state is passed to DEMOLISH properly (true)';
+ok $status[1], 'in_global_destruction state is passed to DEMOLISH properly (true)';
+
+is $?, 0, 'exited successfully';
 
 done_testing;

diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index b095d32..143228a 100644 (file)
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -693,11 +693,14 @@ CODE:
     len      = AvFILLp(demolishall) + 1;
     if(len > 0){
         GV* const statusvalue = gv_fetchpvs("?", 0, SVt_PV);
-        SAVESPTR(GvSV(statusvalue)); /* local $? */
+
+        if(statusvalue){ /* it can be NULL */
+            SAVESPTR(GvSV(statusvalue)); /* local $? */
+            GvSV(statusvalue) = sv_newmortal();
+        }
         SAVESPTR(ERRSV); /* local $@ */
+        ERRSV = newSVpvs_flags("", SVs_TEMP);
 
-        GvSV(statusvalue) = sv_newmortal();
-        ERRSV             = newSVpvs_flags("", SVs_TEMP);
         for(i = 0; i < len; i++){
             SPAGAIN;