For Mouse::Util::MetaRole
[gitmo/Mouse.git] / t / 030_roles / 019_build.t
CommitLineData
67199842 1#!/usr/bin/env perl
2use strict;
3use warnings;
49a56bba 4use Test::More;
5BEGIN {
6cfa1e5e 6 eval "use Test::Output;";
7 plan skip_all => "Test::Output is required for this test" if $@;
ad022aac 8
6cfa1e5e 9 plan tests => 8;
49a56bba 10}
11
67199842 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
17my @CALLS;
18
19do {
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
28do {
29 package ClassWithBUILD;
30 use Mouse;
6cfa1e5e 31
32 ::stderr_is {
33 with 'TestRole';
34 } '';
67199842 35
36 sub BUILD { push @CALLS, 'ClassWithBUILD::BUILD' }
37};
38
39do {
6cfa1e5e 40 package ExplicitClassWithBUILD;
67199842 41 use Mouse;
67199842 42
6cfa1e5e 43 ::stderr_is {
44 with 'TestRole' => { excludes => 'BUILD' };
45 } '';
67199842 46
6cfa1e5e 47 sub BUILD { push @CALLS, 'ExplicitClassWithBUILD::BUILD' }
48};
67199842 49
6cfa1e5e 50do {
51 package ClassWithoutBUILD;
52 use Mouse;
53 with 'TestRole';
54};
67199842 55
6cfa1e5e 56{
57 is_deeply([splice @CALLS], [], "no calls to BUILD yet");
67199842 58
6cfa1e5e 59 ClassWithBUILD->new;
67199842 60
6cfa1e5e 61 is_deeply([splice @CALLS], [
62 'TestRole::BUILD:before',
63 'ClassWithBUILD::BUILD',
64 'TestRole::BUILD:after',
65 ]);
67199842 66
6cfa1e5e 67 ClassWithoutBUILD->new;
67199842 68
6cfa1e5e 69 is_deeply([splice @CALLS], [
70 'TestRole::BUILD:before',
71 'TestRole::BUILD',
72 'TestRole::BUILD:after',
73 ]);
67199842 74
6cfa1e5e 75 if (ClassWithBUILD->meta->is_mutable) {
76 ClassWithBUILD->meta->make_immutable;
77 ClassWithoutBUILD->meta->make_immutable;
78 redo;
79 }
80}
67199842 81