Ignore "used only once" warning
[gitmo/Mouse.git] / t / 014-build.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More tests => 3;
5
6 my @called;
7
8 do {
9     package Class;
10     use Mouse;
11
12     sub BUILD {
13         push @called, 'Class::BUILD';
14     }
15
16     sub BUILDALL {
17         my $self = shift;
18         push @called, 'Class::BUILDALL';
19         $self->SUPER::BUILDALL(@_);
20     }
21
22     package Child;
23     use Mouse;
24     extends 'Class';
25
26     sub BUILD {
27         push @called, 'Child::BUILD';
28     }
29
30     sub BUILDALL {
31         my $self = shift;
32         push @called, 'Child::BUILDALL';
33         $self->SUPER::BUILDALL(@_);
34     }
35 };
36
37 is_deeply([splice @called], [], "no BUILD calls yet");
38
39 my $object = Class->new;
40
41 is_deeply([splice @called], ["Class::BUILDALL", "Class::BUILD"]);
42
43 my $child = Child->new;
44
45 is_deeply([splice @called], ["Child::BUILDALL", "Class::BUILDALL", "Class::BUILD", "Child::BUILD"]);