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         builder   => '_build_age',
  31         lazy      => 1,
  32         clearer   => 'clear_age',
  33         predicate => 'has_age',
  34     );
  35
  36     sub default_age { 20 }
  37     sub _build_age {
  38         my $self = shift;
  39         ++$lazy_builder_called;
  40         return $self->default_age;
  41     };
  42
  43 };
  44
  45 # eager builder
  46 my $object = Class->new(name => "Bob");
  47 ok($object->has_name, "predicate: value from constructor");
  48 is($builder_called, 0, "builder not called in the constructor when we pass a value");
  49 is($object->name, "Bob", "builder doesn't matter when we just set the value in constructor");
  50 $object->name("Bill");
  51 is($object->name, "Bill", "builder doesn't matter when we just set the value in writer");
  52 is($builder_called, 0, "builder not called in the setter");
  53 $builder_called = 0;
  54
  55 $object->clear_name;
  56 ok(!$object->has_name, "predicate: no value after clear");
  57 is($object->name, undef, "eager builder does NOT swoop in after clear");
  58 ok(!$object->has_name, "predicate: no value after clear and get");
  59 is($builder_called, 0, "builder not called in the getter, even after clear");
  60 $builder_called = 0;
  61
  62 my $object2 = Class->new;
  63 ok($object2->has_name, "predicate: value from eager builder");
  64 is($object2->name, "FRANK", "builder called to provide the default value");
  65 is($builder_called, 1, "builder called ONCE to provide the default value");
  66
  67 # lazy builder
  68 my $object3 = Class->new;
  69 is($lazy_builder_called, 0, "lazy builder not called yet");
  70 ok(!$object3->has_age, "predicate: no age yet");
  71 is($object3->age, 20, "lazy builder value");
  72 ok($object3->has_age, "predicate: have value after get");
  73 is($lazy_builder_called, 1, "lazy builder called on get");
  74 is($object3->age, 20, "lazy builder value");
  75 is($lazy_builder_called, 1, "lazy builder not called on subsequent gets");
  76 ok($object3->has_age, "predicate: have value after subsequent gets");
  77
  78 $lazy_builder_called = 0;
  79 $object3->clear_age;
  80 ok(!$object3->has_age, "predicate: no value after clear");
  81 is($lazy_builder_called, 0, "lazy builder not called on clear");
  82 is($object3->age, 20, "lazy builder value");
  83 ok($object3->has_age, "predicate: have value after clear and get");
  84 is($lazy_builder_called, 1, "lazy builder called on get after clear");
  85
  86 $lazy_builder_called = 0;
  87 my $object4 = Class->new(age => 50);
  88 ok($object4->has_age, "predicate: have value from constructor");
  89 is($lazy_builder_called, 0, "lazy builder not called yet");
  90 is($object4->age, 50, "value from constructor");
  91 is($lazy_builder_called, 0, "lazy builder not called if value is from constructor");
  92
  93 $object4->clear_age;
  94 ok(!$object4->has_age, "predicate: no value after clear");
  95 is($lazy_builder_called, 0, "lazy builder not called on clear");
  96 is($object4->age, 20, "lazy builder value");
  97 ok($object4->has_age, "predicate: have value after clear and get");
  98 is($lazy_builder_called, 1, "lazy builder called on get after clear");