t/014-build.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 12;
   5
   6 my ($class_build, $child_build) = (0, 0);
   7 my ($class_buildall, $child_buildall) = (0, 0);
   8
   9 do {
  10     package Class;
  11     use Mouse;
  12
  13     sub BUILD {
  14         ++$class_build;
  15     }
  16
  17     sub BUILDALL {
  18         my $self = shift;
  19         ++$class_buildall;
  20         $self->SUPER::BUILDALL(@_);
  21     }
  22
  23     package Child;
  24     use Mouse;
  25     extends 'Class';
  26
  27     sub BUILD {
  28         ++$child_build;
  29     }
  30
  31     sub BUILDALL {
  32         my $self = shift;
  33         ++$child_buildall;
  34         $self->SUPER::BUILDALL(@_);
  35     }
  36
  37
  38 };
  39
  40 is($class_build, 0, "no calls to Class->BUILD");
  41 is($child_build, 0, "no calls to Child->BUILD");
  42
  43 is($class_buildall, 0, "no calls to Class->BUILDALL");
  44 is($child_buildall, 0, "no calls to Child->BUILDALL");
  45
  46 my $object = Class->new;
  47
  48 is($class_build, 1, "Class->new calls Class->BUILD");
  49 is($child_build, 0, "Class->new does not call Child->BUILD");
  50
  51 is($class_buildall, 1, "Class->new calls Class->BUILDALL");
  52 is($child_buildall, 0, "no calls to Child->BUILDALL");
  53
  54 my $child = Child->new;
  55
  56 is($child_build, 1, "Child->new calls Child->BUILD");
  57 is($class_build, 2, "Child->new also calls Class->BUILD");
  58
  59 is($child_buildall, 1, "Child->new calls Child->BUILDALL");
  60 is($class_buildall, 2, "Child->BUILDALL calls Class->BUILDALL (but not Child->new)");
  61