t/030_roles/019_build.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Moose;
   6 BEGIN {
   7     eval "use Test::Output;";
   8     plan skip_all => "Test::Output is required for this test" if $@;
   9 }
  10
  11 # this test script ensures that my idiom of:
  12 # role: sub BUILD, after BUILD
  13 # continues to work to run code after object initialization, whether the class
  14 # has a BUILD method or not
  15 # note: as of moose 0.95, this idiom is no longer necessary ('after BUILD' on
  16 # its own is sufficient)  -doy
  17
  18 my @CALLS;
  19
  20 do {
  21     package TestRole;
  22     use Moose::Role;
  23
  24     sub BUILD           { push @CALLS, 'TestRole::BUILD' }
  25     before BUILD => sub { push @CALLS, 'TestRole::BUILD:before' };
  26     after  BUILD => sub { push @CALLS, 'TestRole::BUILD:after' };
  27 };
  28
  29 do {
  30     package ClassWithBUILD;
  31     use Moose;
  32
  33     ::stderr_is {
  34         with 'TestRole';
  35     } '';
  36
  37     sub BUILD { push @CALLS, 'ClassWithBUILD::BUILD' }
  38 };
  39
  40 do {
  41     package ExplicitClassWithBUILD;
  42     use Moose;
  43
  44     ::stderr_is {
  45         with 'TestRole' => { excludes => 'BUILD' };
  46     } '';
  47
  48     sub BUILD { push @CALLS, 'ExplicitClassWithBUILD::BUILD' }
  49 };
  50
  51 do {
  52     package ClassWithoutBUILD;
  53     use Moose;
  54     with 'TestRole';
  55 };
  56
  57 do {
  58     package TestRoleWithoutBUILD;
  59     use Moose::Role;
  60
  61     before BUILD => sub { push @CALLS, 'TestRoleWithoutBUILD::BUILD:before' };
  62     after  BUILD => sub { push @CALLS, 'TestRoleWithoutBUILD::BUILD:after' };
  63 };
  64
  65 do {
  66     package AnotherClassWithBUILD;
  67     use Moose;
  68
  69     ::stderr_is {
  70         with 'TestRoleWithoutBUILD';
  71     } '';
  72
  73     sub BUILD { push @CALLS, 'AnotherClassWithBUILD::BUILD' }
  74 };
  75
  76 do {
  77     package AnotherClassWithoutBUILD;
  78     use Moose;
  79
  80     ::stderr_is {
  81         with 'TestRoleWithoutBUILD';
  82     } '';
  83 };
  84
  85 with_immutable {
  86     is_deeply([splice @CALLS], [], "no calls to BUILD yet");
  87
  88     ClassWithBUILD->new;
  89
  90     is_deeply([splice @CALLS], [
  91         'TestRole::BUILD:before',
  92         'ClassWithBUILD::BUILD',
  93         'TestRole::BUILD:after',
  94     ]);
  95
  96     ClassWithoutBUILD->new;
  97
  98     is_deeply([splice @CALLS], [
  99         'TestRole::BUILD:before',
 100         'TestRole::BUILD',
 101         'TestRole::BUILD:after',
 102     ]);
 103
 104     AnotherClassWithBUILD->new;
 105
 106     is_deeply([splice @CALLS], [
 107         'TestRoleWithoutBUILD::BUILD:before',
 108         'AnotherClassWithBUILD::BUILD',
 109         'TestRoleWithoutBUILD::BUILD:after',
 110     ]);
 111
 112     AnotherClassWithoutBUILD->new;
 113
 114     is_deeply([splice @CALLS], [
 115         'TestRoleWithoutBUILD::BUILD:before',
 116         'TestRoleWithoutBUILD::BUILD:after',
 117     ]);
 118 } qw(ClassWithBUILD        ClassWithoutBUILD
 119      AnotherClassWithBUILD AnotherClassWithoutBUILD);
 120
 121 done_testing;