t/roles/build.t

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