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