t/030_roles/019_build.t

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