From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 10 Jun 2008 03:13:53 +0000 (+0000)
Subject: fixing bug, thanks to Sartak
X-Git-Tag: 0_55~123
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f93f7be938c5225e9c233a5004aea696d7e36dd4;p=gitmo%2FMoose.git

fixing bug, thanks to Sartak
---

diff --git a/Changes b/Changes
index 3adb109..2b74acf 100644
--- a/Changes
+++ b/Changes
@@ -16,7 +16,13 @@ Revision history for Perl extension Moose
       Moose::Meta::Role
       Moose::Meta::Role::Composite
       Moose::Util::TypeConstraints
-      - 
+      - switched usage of reftype to ref because 
+        it is much faster
+        
+    * Moose::Object
+      - fixed how DEMOLISHALL is called so that it 
+        can be overrided in subclasses (thanks to Sartak)
+        - added test for this (thanks to Sartak)
 
 0.48 Thurs. May 29, 2008
     (early morning release engineering)--
diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index 1806daa..6426dd6 100644
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -9,7 +9,7 @@ use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class';
 
 use Carp 'confess';
 
-our $VERSION   = '0.13';
+our $VERSION   = '0.14';
 our $AUTHORITY = 'cpan:STEVAN';
 
 sub new {
@@ -63,7 +63,7 @@ sub DESTROY {
         return;
     }
     # otherwise it is normal destruction
-    goto &DEMOLISHALL;
+    $_[0]->DEMOLISHALL;
 }
 
 # new does() methods will be created 
diff --git a/t/100_bugs/014_DEMOLISHALL.t b/t/100_bugs/014_DEMOLISHALL.t
new file mode 100644
index 0000000..5fdca53
--- /dev/null
+++ b/t/100_bugs/014_DEMOLISHALL.t
@@ -0,0 +1,74 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 20;
+
+our ($class_demolish, $child_demolish) = (0, 0);
+our ($class_demolishall, $child_demolishall) = (0, 0);
+
+do {
+    package Class;
+    use Moose;
+
+    sub DEMOLISH {
+        ++$::class_demolish;
+    }
+
+    sub DEMOLISHALL {
+        my $self = shift;
+        ++$::class_demolishall;
+        $self->SUPER::DEMOLISHALL(@_);
+    }
+
+    package Child;
+    use Moose;
+    extends 'Class';
+
+    sub DEMOLISH {
+        ++$::child_demolish;
+    }
+
+    sub DEMOLISHALL {
+        my $self = shift;
+        ++$::child_demolishall;
+        $self->SUPER::DEMOLISHALL(@_);
+    }
+};
+
+is($class_demolish, 0, "no calls to Class->DEMOLISH");
+is($child_demolish, 0, "no calls to Child->DEMOLISH");
+
+is($class_demolishall, 0, "no calls to Class->DEMOLISHALL");
+is($child_demolishall, 0, "no calls to Child->DEMOLISHALL");
+
+do {
+    my $object = Class->new;
+
+    is($class_demolish, 0, "Class->new does not call Class->DEMOLISH");
+    is($child_demolish, 0, "Class->new does not call Child->DEMOLISH");
+
+    is($class_demolishall, 0, "Class->new does not call Class->DEMOLISHALL");
+    is($child_demolishall, 0, "Class->new does not call Child->DEMOLISHALL");
+};
+
+is($class_demolish, 1, "Class->DESTROY calls Class->DEMOLISH");
+is($child_demolish, 0, "Class->DESTROY does not call Child->DEMOLISH");
+
+is($class_demolishall, 1, "Class->DESTROY calls Class->DEMOLISHALL");
+is($child_demolishall, 0, "no calls to Child->DEMOLISHALL");
+
+do {
+    my $child = Child->new;
+
+    is($class_demolish, 1, "Child->new does not call Class->DEMOLISH");
+    is($child_demolish, 0, "Child->new does not call Child->DEMOLISH");
+
+    is($class_demolishall, 1, "Child->DEMOLISHALL does not call Class->DEMOLISHALL (but not Child->new)");
+    is($child_demolishall, 0, "Child->new does not call Child->DEMOLISHALL");
+};
+
+is($child_demolish, 1, "Child->DESTROY calls Child->DEMOLISH");
+is($class_demolish, 2, "Child->DESTROY also calls Class->DEMOLISH");
+
+is($child_demolishall, 1, "Child->DESTROY calls Child->DEMOLISHALL");
+is($class_demolishall, 2, "Child->DEMOLISHALL calls Class->DEMOLISHALL (but not Child->DESTROY)");