#!/usr/bin/env perl use strict; use warnings; use Test::More; BEGIN { eval "use Test::Output;"; plan skip_all => "Test::Output is required for this test" if $@; plan tests => 8; } # this test script ensures that my idiom of: # role: sub BUILD, after BUILD # continues to work to run code after object initialization, whether the class # has a BUILD method or not my @CALLS; do { package TestRole; use Mouse::Role; sub BUILD { push @CALLS, 'TestRole::BUILD' } before BUILD => sub { push @CALLS, 'TestRole::BUILD:before' }; after BUILD => sub { push @CALLS, 'TestRole::BUILD:after' }; }; do { package ClassWithBUILD; use Mouse; ::stderr_is { with 'TestRole'; } ''; sub BUILD { push @CALLS, 'ClassWithBUILD::BUILD' } }; do { package ExplicitClassWithBUILD; use Mouse; ::stderr_is { with 'TestRole' => { -excludes => 'BUILD' }; } ''; sub BUILD { push @CALLS, 'ExplicitClassWithBUILD::BUILD' } }; do { package ClassWithoutBUILD; use Mouse; with 'TestRole'; }; { is_deeply([splice @CALLS], [], "no calls to BUILD yet"); ClassWithBUILD->new; is_deeply([splice @CALLS], [ 'TestRole::BUILD:before', 'ClassWithBUILD::BUILD', 'TestRole::BUILD:after', ]); ClassWithoutBUILD->new; is_deeply([splice @CALLS], [ 'TestRole::BUILD:before', 'TestRole::BUILD', 'TestRole::BUILD:after', ]); if (ClassWithBUILD->meta->is_mutable) { ClassWithBUILD->meta->make_immutable; ClassWithoutBUILD->meta->make_immutable; redo; } }