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     plan tests => 8;
   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
  16 my @CALLS;
  17
  18 do {
  19     package TestRole;
  20     use Mouse::Role;
  21
  22     sub BUILD           { push @CALLS, 'TestRole::BUILD' }
  23     before BUILD => sub { push @CALLS, 'TestRole::BUILD:before' };
  24     after  BUILD => sub { push @CALLS, 'TestRole::BUILD:after' };
  25 };
  26
  27 do {
  28     package ClassWithBUILD;
  29     use Mouse;
  30
  31     ::stderr_is {
  32         with 'TestRole';
  33     } '';
  34
  35     sub BUILD { push @CALLS, 'ClassWithBUILD::BUILD' }
  36 };
  37
  38 do {
  39     package ExplicitClassWithBUILD;
  40     use Mouse;
  41
  42     ::stderr_is {
  43         with 'TestRole' => { excludes => 'BUILD' };
  44     } '';
  45
  46     sub BUILD { push @CALLS, 'ExplicitClassWithBUILD::BUILD' }
  47 };
  48
  49 do {
  50     package ClassWithoutBUILD;
  51     use Mouse;
  52     with 'TestRole';
  53 };
  54
  55 {
  56     is_deeply([splice @CALLS], [], "no calls to BUILD yet");
  57
  58     ClassWithBUILD->new;
  59
  60     is_deeply([splice @CALLS], [
  61         'TestRole::BUILD:before',
  62         'ClassWithBUILD::BUILD',
  63         'TestRole::BUILD:after',
  64     ]);
  65
  66     ClassWithoutBUILD->new;
  67
  68     is_deeply([splice @CALLS], [
  69         'TestRole::BUILD:before',
  70         'TestRole::BUILD',
  71         'TestRole::BUILD:after',
  72     ]);
  73
  74     if (ClassWithBUILD->meta->is_mutable) {
  75         ClassWithBUILD->meta->make_immutable;
  76         ClassWithoutBUILD->meta->make_immutable;
  77         redo;
  78     }
  79 }
  80