t/001_mouse/015-demolish.t

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