t/015-demolish.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 20;
   5
   6 my ($class_demolish, $child_demolish) = (0, 0);
   7 my ($class_demolishall, $child_demolishall) = (0, 0);
   8
   9 do {
  10     package Class;
  11     use Mouse;
  12
  13     sub DEMOLISH {
  14         ++$class_demolish;
  15     }
  16
  17     sub DEMOLISHALL {
  18         my $self = shift;
  19         ++$class_demolishall;
  20         $self->SUPER::DEMOLISHALL(@_);
  21     }
  22
  23     package Child;
  24     use Mouse;
  25     extends 'Class';
  26
  27     sub DEMOLISH {
  28         ++$child_demolish;
  29     }
  30
  31     sub DEMOLISHALL {
  32         my $self = shift;
  33         ++$child_demolishall;
  34         $self->SUPER::DEMOLISHALL(@_);
  35     }
  36 };
  37
  38 is($class_demolish, 0, "no calls to Class->DEMOLISH");
  39 is($child_demolish, 0, "no calls to Child->DEMOLISH");
  40
  41 is($class_demolishall, 0, "no calls to Class->DEMOLISHALL");
  42 is($child_demolishall, 0, "no calls to Child->DEMOLISHALL");
  43
  44 do {
  45     my $object = Class->new;
  46
  47     is($class_demolish, 0, "Class->new does not call Class->DEMOLISH");
  48     is($child_demolish, 0, "Class->new does not call Child->DEMOLISH");
  49
  50     is($class_demolishall, 0, "Class->new does not call Class->DEMOLISHALL");
  51     is($child_demolishall, 0, "Class->new does not call Child->DEMOLISHALL");
  52 };
  53
  54 is($class_demolish, 1, "Class->DESTROY calls Class->DEMOLISH");
  55 is($child_demolish, 0, "Class->DESTROY does not call Child->DEMOLISH");
  56
  57 is($class_demolishall, 1, "Class->DESTROY calls Class->DEMOLISHALL");
  58 is($child_demolishall, 0, "no calls to Child->DEMOLISHALL");
  59
  60 do {
  61     my $child = Child->new;
  62
  63     is($class_demolish, 1, "Child->new does not call Class->DEMOLISH");
  64     is($child_demolish, 0, "Child->new does not call Child->DEMOLISH");
  65
  66     is($class_demolishall, 1, "Child->DEMOLISHALL does not call Class->DEMOLISHALL (but not Child->new)");
  67     is($child_demolishall, 0, "Child->new does not call Child->DEMOLISHALL");
  68 };
  69
  70 is($child_demolish, 1, "Child->DESTROY calls Child->DEMOLISH");
  71 is($class_demolish, 2, "Child->DESTROY also calls Class->DEMOLISH");
  72
  73 is($child_demolishall, 1, "Child->DESTROY calls Child->DEMOLISHALL");
  74 is($class_demolishall, 2, "Child->DEMOLISHALL calls Class->DEMOLISHALL (but not Child->DESTROY)");
  75