t/023-builder.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 34;
   5
   6 my $builder_called = 0;
   7 my $lazy_builder_called = 0;
   8
   9 do {
  10     package Class;
  11     use Mouse;
  12
  13     has name => (
  14         is        => 'rw',
  15         isa       => 'Str',
  16         builder   => '_build_name',
  17         predicate => 'has_name',
  18         clearer   => 'clear_name',
  19     );
  20
  21     sub _build_name {
  22         my $self = shift;
  23         ++$builder_called;
  24         return "FRANK";
  25     };
  26
  27     has age => (
  28         is         => 'ro',
  29         isa        => 'Int',
  30         lazy_build => 1,
  31         clearer    => 'clear_age',
  32         predicate  => 'has_age',
  33     );
  34
  35     sub default_age { 20 }
  36     sub _build_age {
  37         my $self = shift;
  38         ++$lazy_builder_called;
  39         return $self->default_age;
  40     };
  41
  42 };
  43
  44 # eager builder
  45 my $object = Class->new(name => "Bob");
  46 ok($object->has_name, "predicate: value from constructor");
  47 is($builder_called, 0, "builder not called in the constructor when we pass a value");
  48 is($object->name, "Bob", "builder doesn't matter when we just set the value in constructor");
  49 $object->name("Bill");
  50 is($object->name, "Bill", "builder doesn't matter when we just set the value in writer");
  51 is($builder_called, 0, "builder not called in the setter");
  52 $builder_called = 0;
  53
  54 $object->clear_name;
  55 ok(!$object->has_name, "predicate: no value after clear");
  56 is($object->name, undef, "eager builder does NOT swoop in after clear");
  57 ok(!$object->has_name, "predicate: no value after clear and get");
  58 is($builder_called, 0, "builder not called in the getter, even after clear");
  59 $builder_called = 0;
  60
  61 my $object2 = Class->new;
  62 ok($object2->has_name, "predicate: value from eager builder");
  63 is($object2->name, "FRANK", "builder called to provide the default value");
  64 is($builder_called, 1, "builder called ONCE to provide the default value");
  65
  66 # lazy builder
  67 my $object3 = Class->new;
  68 is($lazy_builder_called, 0, "lazy builder not called yet");
  69 ok(!$object3->has_age, "predicate: no age yet");
  70 is($object3->age, 20, "lazy builder value");
  71 ok($object3->has_age, "predicate: have value after get");
  72 is($lazy_builder_called, 1, "lazy builder called on get");
  73 is($object3->age, 20, "lazy builder value");
  74 is($lazy_builder_called, 1, "lazy builder not called on subsequent gets");
  75 ok($object3->has_age, "predicate: have value after subsequent gets");
  76
  77 $lazy_builder_called = 0;
  78 $object3->clear_age;
  79 ok(!$object3->has_age, "predicate: no value after clear");
  80 is($lazy_builder_called, 0, "lazy builder not called on clear");
  81 is($object3->age, 20, "lazy builder value");
  82 ok($object3->has_age, "predicate: have value after clear and get");
  83 is($lazy_builder_called, 1, "lazy builder called on get after clear");
  84
  85 $lazy_builder_called = 0;
  86 my $object4 = Class->new(age => 50);
  87 ok($object4->has_age, "predicate: have value from constructor");
  88 is($lazy_builder_called, 0, "lazy builder not called yet");
  89 is($object4->age, 50, "value from constructor");
  90 is($lazy_builder_called, 0, "lazy builder not called if value is from constructor");
  91
  92 $object4->clear_age;
  93 ok(!$object4->has_age, "predicate: no value after clear");
  94 is($lazy_builder_called, 0, "lazy builder not called on clear");
  95 is($object4->age, 20, "lazy builder value");
  96 ok($object4->has_age, "predicate: have value after clear and get");
  97 is($lazy_builder_called, 1, "lazy builder called on get after clear");