t/001_mouse/023-builder.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 47;
   5 use Test::Exception;
   6
   7 my $builder_called = 0;
   8 my $lazy_builder_called = 0;
   9
  10 do {
  11     package Class;
  12     use Mouse;
  13
  14     has name => (
  15         is        => 'rw',
  16         isa       => 'Str',
  17         builder   => '_build_name',
  18         predicate => 'has_name',
  19         clearer   => 'clear_name',
  20     );
  21
  22     sub _build_name {
  23         my $self = shift;
  24         ++$builder_called;
  25         return "FRANK";
  26     };
  27
  28     has age => (
  29         is         => 'ro',
  30         isa        => 'Int',
  31         lazy_build => 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");
  99
 100 do {
 101     package Class::Error;
 102     use Mouse;
 103
 104     ::throws_ok {
 105         has error => (
 106             lazy_build => 1,
 107             default => 1,
 108         );
 109     } qr/You can not use lazy_build and default for the same attribute \(error\)/;
 110 };
 111
 112 my @calls;
 113 do {
 114     package Class::CustomBuilder;
 115     use Mouse;
 116
 117     has custom => (
 118         is => 'ro',
 119         lazy_build => 1,
 120         builder    => 'build_my_customs',
 121         predicate  => 'has_my_customs',
 122         clearer    => 'clear_my_customs',
 123     );
 124
 125     sub build_my_customs {
 126         push @calls, 'build_my_customs';
 127         return 'yo';
 128     }
 129 };
 130
 131 my $cb = Class::CustomBuilder->new;
 132 ok(!$cb->has_my_customs, "correct predicate");
 133 is($cb->custom, 'yo');
 134 is_deeply([splice @calls], ['build_my_customs']);
 135 ok($cb->has_my_customs, "correct predicate");
 136 ok($cb->clear_my_customs, "correct clearer");
 137 ok(!$cb->has_my_customs, "correct predicate");
 138
 139 do {
 140     package Class::UnderscoreBuilder;
 141     use Mouse;
 142
 143     has _attr => (
 144         is => 'ro',
 145         lazy_build => 1,
 146     );
 147
 148     sub _build__attr {
 149         push @calls, '_build__attr';
 150         return 'ping';
 151     }
 152 };
 153
 154 my $cub = Class::UnderscoreBuilder->new;
 155 ok(!$cub->_has_attr, "correct predicate");
 156 is($cub->_attr, 'ping');
 157 is_deeply([splice @calls], ['_build__attr']);
 158 ok($cub->_has_attr, "correct predicate");
 159 ok($cub->_clear_attr, "correct clearer");
 160 ok(!$cub->_has_attr, "correct predicate");
 161