From: gfx <gfuji@cpan.org>
Date: Tue, 3 Nov 2009 02:53:57 +0000 (+0900)
Subject: BUILDALL and DEMOLISHALL are no longer called by the default constructor/destructor.
X-Git-Tag: 0.40_06~38
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=224bfdd88300af5e6aa044b64111c3e0b1e64e94;p=gitmo%2FMouse.git

BUILDALL and DEMOLISHALL are no longer called by the default constructor/destructor.
---

diff --git a/t/001_mouse/014-build.t b/t/001_mouse/014-build.t
index 0d95047..918a7d6 100644
--- a/t/001_mouse/014-build.t
+++ b/t/001_mouse/014-build.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 3;
+use Test::More tests => 5;
 
 my @called;
 
@@ -13,11 +13,11 @@ do {
         push @called, 'Class::BUILD';
     }
 
-    sub BUILDALL {
-        my $self = shift;
-        push @called, 'Class::BUILDALL';
-        $self->SUPER::BUILDALL(@_);
-    }
+#    sub BUILDALL {
+#        my $self = shift;
+#        push @called, 'Class::BUILDALL';
+#        $self->SUPER::BUILDALL(@_);
+#    }
 
     package Child;
     use Mouse;
@@ -27,19 +27,31 @@ do {
         push @called, 'Child::BUILD';
     }
 
-    sub BUILDALL {
-        my $self = shift;
-        push @called, 'Child::BUILDALL';
-        $self->SUPER::BUILDALL(@_);
-    }
+#    sub BUILDALL {
+#        my $self = shift;
+#        push @called, 'Child::BUILDALL';
+#        $self->SUPER::BUILDALL(@_);
+#    }
 };
 
 is_deeply([splice @called], [], "no BUILD calls yet");
 
 my $object = Class->new;
 
-is_deeply([splice @called], ["Class::BUILDALL", "Class::BUILD"]);
+is_deeply([splice @called], ["Class::BUILD"]);
 
 my $child = Child->new;
 
-is_deeply([splice @called], ["Child::BUILDALL", "Class::BUILDALL", "Class::BUILD", "Child::BUILD"]);
+is_deeply([splice @called], ["Class::BUILD", "Child::BUILD"]);
+
+Class->meta->make_immutable;
+Child->meta->make_immutable;
+
+$object = Class->new;
+
+is_deeply([splice @called], ["Class::BUILD"], 'after make_immutable');
+
+$child = Child->new;
+
+is_deeply([splice @called], ["Class::BUILD", "Child::BUILD"], 'after make_immutable');
+
diff --git a/t/001_mouse/015-demolish.t b/t/001_mouse/015-demolish.t
index 123c2d2..255cecf 100644
--- a/t/001_mouse/015-demolish.t
+++ b/t/001_mouse/015-demolish.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 5;
+use Test::More tests => 10;
 
 my @called;
 
@@ -13,11 +13,11 @@ do {
         push @called, 'Class::DEMOLISH';
     }
 
-    sub DEMOLISHALL {
-        my $self = shift;
-        push @called, 'Class::DEMOLISHALL';
-        $self->SUPER::DEMOLISHALL(@_);
-    }
+#    sub DEMOLISHALL {
+#        my $self = shift;
+#        push @called, 'Class::DEMOLISHALL';
+#        $self->SUPER::DEMOLISHALL(@_);
+#    }
 
     package Child;
     use Mouse;
@@ -27,13 +27,34 @@ do {
         push @called, 'Child::DEMOLISH';
     }
 
-    sub DEMOLISHALL {
-        my $self = shift;
-        push @called, 'Child::DEMOLISHALL';
-        $self->SUPER::DEMOLISHALL(@_);
-    }
+#    sub DEMOLISHALL {
+#        my $self = shift;
+#        push @called, 'Child::DEMOLISHALL';
+#        $self->SUPER::DEMOLISHALL(@_);
+#    }
+};
+
+is_deeply([splice @called], [], "no DEMOLISH calls yet");
+
+do {
+    my $object = Class->new;
+
+    is_deeply([splice @called], [], "no DEMOLISH calls yet");
 };
 
+is_deeply([splice @called], ['Class::DEMOLISH']);
+
+do {
+    my $child = Child->new;
+    is_deeply([splice @called], [], "no DEMOLISH calls yet");
+
+};
+
+is_deeply([splice @called], ['Child::DEMOLISH', 'Class::DEMOLISH']);
+
+Class->meta->make_immutable();
+Child->meta->make_immutable();
+
 is_deeply([splice @called], [], "no DEMOLISH calls yet");
 
 do {
@@ -42,7 +63,7 @@ do {
     is_deeply([splice @called], [], "no DEMOLISH calls yet");
 };
 
-is_deeply([splice @called], ['Class::DEMOLISHALL', 'Class::DEMOLISH']);
+is_deeply([splice @called], ['Class::DEMOLISH'], 'after make_immutable');
 
 do {
     my $child = Child->new;
@@ -50,4 +71,4 @@ do {
 
 };
 
-is_deeply([splice @called], ['Child::DEMOLISHALL', 'Class::DEMOLISHALL', 'Child::DEMOLISH', 'Class::DEMOLISH']);
+is_deeply([splice @called], ['Child::DEMOLISH', 'Class::DEMOLISH'], 'after make_immutable');
diff --git a/t/100_bugs/014_DEMOLISHALL.t b/t/100_bugs/014_DEMOLISHALL.t
deleted file mode 100644
index f3cb306..0000000
--- a/t/100_bugs/014_DEMOLISHALL.t
+++ /dev/null
@@ -1,54 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use Test::More tests => 5;
-
-my @called;
-
-do {
-    package Class;
-    use Mouse;
-
-    sub DEMOLISH {
-        push @called, 'Class::DEMOLISH';
-    }
-
-    sub DEMOLISHALL {
-        my $self = shift;
-        push @called, 'Class::DEMOLISHALL';
-        $self->SUPER::DEMOLISHALL(@_);
-    }
-
-    package Child;
-    use Mouse;
-    extends 'Class';
-
-    sub DEMOLISH {
-        push @called, 'Child::DEMOLISH';
-    }
-
-    sub DEMOLISHALL {
-        my $self = shift;
-        push @called, 'Child::DEMOLISHALL';
-        $self->SUPER::DEMOLISHALL(@_);
-    }
-};
-
-is_deeply([splice @called], [], "no DEMOLISH calls yet");
-
-do {
-    my $object = Class->new;
-
-    is_deeply([splice @called], [], "no DEMOLISH calls yet");
-};
-
-is_deeply([splice @called], ['Class::DEMOLISHALL', 'Class::DEMOLISH']);
-
-do {
-    my $child = Child->new;
-    is_deeply([splice @called], [], "no DEMOLISH calls yet");
-
-};
-
-is_deeply([splice @called], ['Child::DEMOLISHALL', 'Class::DEMOLISHALL', 'Child::DEMOLISH', 'Class::DEMOLISH']);
-
diff --git a/t/100_bugs/021_DEMOLISHALL_shortcutted.t b/t/100_bugs/021_DEMOLISHALL_shortcutted.t
deleted file mode 100644
index ba1833e..0000000
--- a/t/100_bugs/021_DEMOLISHALL_shortcutted.t
+++ /dev/null
@@ -1,32 +0,0 @@
-## This test ensures that sub DEMOLISHALL fires even if there is no sub DEMOLISH
-## Currently fails because of a bad optimization in DESTROY
-## Feb 12, 2009 -- Evan Carroll me@evancarroll.com
-package Role::DemolishAll;
-use Mouse::Role;
-our $ok = 0;
-
-sub BUILD { $ok = 0 };
-after 'DEMOLISHALL' => sub { $Role::DemolishAll::ok++ };
-
-package DemolishAll::WithoutDemolish;
-use Mouse;
-with 'Role::DemolishAll';
-
-package DemolishAll::WithDemolish;
-use Mouse;
-with 'Role::DemolishAll';
-sub DEMOLISH {};
-
-
-package main;
-use Test::More tests => 2;
-
-my $m = DemolishAll::WithDemolish->new;
-undef $m;
-is ( $Role::DemolishAll::ok, 1, 'DemolishAll w/ explicit DEMOLISH sub' );
-
-$m = DemolishAll::WithoutDemolish->new;
-undef $m;
-is ( $Role::DemolishAll::ok, 1, 'DemolishAll wo/ explicit DEMOLISH sub' );
-
-1;