Commit | Line | Data |
8bfccdda |
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; |