t/030_roles/019_build.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 6;
   5
   6 # this test script ensures that my idiom of:
   7 # role: sub BUILD, after BUILD
   8 # continues to work to run code after object initialization, whether the class
   9 # has a BUILD method or not
  10
  11 my @CALLS;
  12
  13 do {
  14     package TestRole;
  15     use Mouse::Role;
  16
  17     sub BUILD           { push @CALLS, 'TestRole::BUILD' }
  18     before BUILD => sub { push @CALLS, 'TestRole::BUILD:before' };
  19     after  BUILD => sub { push @CALLS, 'TestRole::BUILD:after' };
  20 };
  21
  22 do {
  23     package ClassWithBUILD;
  24     use Mouse;
  25     with 'TestRole';
  26
  27     sub BUILD { push @CALLS, 'ClassWithBUILD::BUILD' }
  28 };
  29
  30 do {
  31     package ClassWithoutBUILD;
  32     use Mouse;
  33     with 'TestRole';
  34 };
  35
  36 is_deeply([splice @CALLS], [], "no calls to BUILD yet");
  37
  38 ClassWithBUILD->new;
  39
  40 is_deeply([splice @CALLS], [
  41     'TestRole::BUILD:before',
  42     'ClassWithBUILD::BUILD',
  43     'TestRole::BUILD:after',
  44 ]);
  45
  46 ClassWithoutBUILD->new;
  47
  48 is_deeply([splice @CALLS], [
  49     'TestRole::BUILD:before',
  50     'TestRole::BUILD',
  51     'TestRole::BUILD:after',
  52 ]);
  53
  54 ClassWithBUILD->meta->make_immutable;
  55 ClassWithoutBUILD->meta->make_immutable;
  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