Commit | Line | Data |
c3398f5b |
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 | |