t/023-builder.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 37;
   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     );
 122
 123     sub build_my_customs {
 124         push @calls, 'build_my_customs';
 125         return 'yo';
 126     }
 127 };
 128
 129
 130 my $cb = Class::CustomBuilder->new;
 131 is($cb->custom, 'yo');
 132 is_deeply(\@calls, ['build_my_customs']);