1#!/usr/bin/env perl
2use strict;
3use warnings;
4use Test::More tests => 15;
5use Test::Mouse;
6
7my @called;
8
9do {
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
38is_deeply([splice @called], [], "no DEMOLISH calls yet");
39
40with_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);
68