t/001_mouse/015-demolish.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 15;
   5 use Test::Mouse;
   6
   7 my @called;
   8
   9 do {
  10     package Class;
  11     use Mouse;
  12
  13     sub DEMOLISH {
  14         push @called, 'Class::DEMOLISH';
  15     }
  16
  17 #    sub DEMOLISHALL {
  18 #        my $self = shift;
  19 #        push @called, 'Class::DEMOLISHALL';
  20 #        $self->SUPER::DEMOLISHALL(@_);
  21 #    }
  22
  23     package Child;
  24     use Mouse;
  25     extends 'Class';
  26
  27     sub DEMOLISH {
  28         push @called, 'Child::DEMOLISH';
  29     }
  30
  31 #    sub DEMOLISHALL {
  32 #        my $self = shift;
  33 #        push @called, 'Child::DEMOLISHALL';
  34 #        $self->SUPER::DEMOLISHALL(@_);
  35 #    }
  36 };
  37
  38 is_deeply([splice @called], [], "no DEMOLISH calls yet");
  39
  40 with_immutable sub {
  41     ok(Class->meta, Class->meta->is_immutable ? 'mutable' : 'immutable');
  42
  43     {
  44         my $object = Class->new;
  45
  46         is_deeply([splice @called], [], "no DEMOLISH calls yet");
  47     }
  48
  49     is_deeply([splice @called], ['Class::DEMOLISH']);
  50
  51     {
  52         my $child = Child->new;
  53         is_deeply([splice @called], [], "no DEMOLISH calls yet");
  54
  55     }
  56
  57     is_deeply([splice @called], ['Child::DEMOLISH', 'Class::DEMOLISH']);
  58
  59     {
  60         my $child = Child->new;
  61         $child->DEMOLISHALL();
  62
  63         is_deeply([splice @called], ['Child::DEMOLISH', 'Class::DEMOLISH'], 'DEMOLISHALL');
  64     }
  65
  66     is_deeply([splice @called], ['Child::DEMOLISH', 'Class::DEMOLISH'], 'DEMOLISHALL');
  67 }, qw(Class Child);