t/001_mouse/013-clearer.t

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