For Mouse::Util::MetaRole
[gitmo/Mouse.git] / t / 030_roles / 019_build.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More;
5 BEGIN {
6     eval "use Test::Output;";
7     plan skip_all => "Test::Output is required for this test" if $@;
8
9     plan tests => 8;
10 }
11
12 # this test script ensures that my idiom of:
13 # role: sub BUILD, after BUILD
14 # continues to work to run code after object initialization, whether the class
15 # has a BUILD method or not
16
17 my @CALLS;
18
19 do {
20     package TestRole;
21     use Mouse::Role;
22
23     sub BUILD           { push @CALLS, 'TestRole::BUILD' }
24     before BUILD => sub { push @CALLS, 'TestRole::BUILD:before' };
25     after  BUILD => sub { push @CALLS, 'TestRole::BUILD:after' };
26 };
27
28 do {
29     package ClassWithBUILD;
30     use Mouse;
31
32     ::stderr_is {
33         with 'TestRole';
34     } '';
35
36     sub BUILD { push @CALLS, 'ClassWithBUILD::BUILD' }
37 };
38
39 do {
40     package ExplicitClassWithBUILD;
41     use Mouse;
42
43     ::stderr_is {
44         with 'TestRole' => { excludes => 'BUILD' };
45     } '';
46
47     sub BUILD { push @CALLS, 'ExplicitClassWithBUILD::BUILD' }
48 };
49
50 do {
51     package ClassWithoutBUILD;
52     use Mouse;
53     with 'TestRole';
54 };
55
56 {
57     is_deeply([splice @CALLS], [], "no calls to BUILD yet");
58
59     ClassWithBUILD->new;
60
61     is_deeply([splice @CALLS], [
62         'TestRole::BUILD:before',
63         'ClassWithBUILD::BUILD',
64         'TestRole::BUILD:after',
65     ]);
66
67     ClassWithoutBUILD->new;
68
69     is_deeply([splice @CALLS], [
70         'TestRole::BUILD:before',
71         'TestRole::BUILD',
72         'TestRole::BUILD:after',
73     ]);
74
75     if (ClassWithBUILD->meta->is_mutable) {
76         ClassWithBUILD->meta->make_immutable;
77         ClassWithoutBUILD->meta->make_immutable;
78         redo;
79     }
80 }
81