t/001_mouse/013-predicate-and-clearer.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Mouse;
   6
   7 my $lazy_run = 0;
   8
   9 do {
  10     package Class;
  11     use Mouse;
  12
  13     has lazy => (
  14         is        => 'rw',
  15         lazy      => 1,
  16         default   => sub { ++$lazy_run },
  17         predicate => 'has_lazy',
  18         clearer   => 'clear_lazy',
  19     );
  20 };
  21
  22 can_ok(Class => 'clear_lazy');
  23
  24 with_immutable(sub{
  25
  26     $lazy_run = 0;
  27     my $object = Class->new;
  28     is($lazy_run, 0, "lazy attribute not yet initialized");
  29
  30     ok(!$object->has_lazy, "no lazy value yet");
  31     is($lazy_run, 0, "lazy attribute not initialized by predicate");
  32
  33     $object->clear_lazy;
  34     is($lazy_run, 0, "lazy attribute not initialized by clearer");
  35
  36     ok(!$object->has_lazy, "no lazy value yet");
  37     is($lazy_run, 0, "lazy attribute not initialized by predicate");
  38
  39     is($object->lazy, 1, "lazy value");
  40     is($lazy_run, 1, "lazy coderef invoked once");
  41
  42     ok($object->has_lazy, "lazy value now");
  43     is($lazy_run, 1, "lazy coderef invoked once");
  44
  45     is($object->lazy, 1, "lazy value is cached");
  46     is($lazy_run, 1, "lazy coderef invoked once");
  47
  48     $object->clear_lazy;
  49     is($lazy_run, 1, "lazy coderef not invoked by clearer");
  50
  51     ok(!$object->has_lazy, "no value now, clearer removed it");
  52     is($lazy_run, 1, "lazy attribute not initialized by predicate");
  53
  54     is($object->lazy, 2, "new lazy value; previous was cleared");
  55     is($lazy_run, 2, "lazy coderef invoked twice");
  56
  57     my $object2 = Class->new(lazy => 'very');
  58     is($lazy_run, 2, "lazy attribute not initialized when an argument is passed to the constructor");
  59
  60     ok($object2->has_lazy, "lazy value now");
  61     is($lazy_run, 2, "lazy attribute not initialized when checked with predicate");
  62
  63     is($object2->lazy, 'very', 'value from the constructor');
  64     is($lazy_run, 2, "lazy coderef not invoked, we already have a value");
  65
  66     $object2->clear_lazy;
  67     is($lazy_run, 2, "lazy attribute not initialized by clearer");
  68
  69     ok(!$object2->has_lazy, "no more lazy value");
  70     is($lazy_run, 2, "lazy attribute not initialized by predicate");
  71
  72     is($object2->lazy, 3, 'new lazy value');
  73     is($lazy_run, 3, "lazy value re-created");
  74
  75 }, qw(Class));
  76
  77 done_testing;