From: gfx Date: Mon, 11 Jan 2010 06:50:43 +0000 (+0900) Subject: Merge clearer.t and predicate.t to predicate-and-clearer.t X-Git-Tag: 0.47~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8bfccddae595b8a1d83fd489d742b30f04e3fe6c;hp=cc368f690a94e2bae71df46f5e956ef86702be55;p=gitmo%2FMouse.git Merge clearer.t and predicate.t to predicate-and-clearer.t --- diff --git a/t/001_mouse/012-predicate.t b/t/001_mouse/012-predicate.t deleted file mode 100644 index cb900a8..0000000 --- a/t/001_mouse/012-predicate.t +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 15; - -my $lazy_run = 0; - -do { - package Class; - use Mouse; - - has lazy => ( - is => 'rw', - lazy => 1, - default => sub { ++$lazy_run }, - predicate => 'has_lazy', - ); -}; - -can_ok(Class => 'has_lazy'); - -my $object = Class->new; -is($lazy_run, 0, "lazy attribute not yet initialized"); - -ok(!$object->has_lazy, "no lazy value yet"); -is($lazy_run, 0, "lazy attribute not initialized by predicate"); - -is($object->lazy, 1, "lazy value"); -is($lazy_run, 1, "lazy coderef invoked once"); - -ok($object->has_lazy, "lazy value now"); -is($lazy_run, 1, "lazy coderef invoked once"); - -is($object->lazy, 1, "lazy value is cached"); -is($lazy_run, 1, "lazy coderef invoked once"); - -my $object2 = Class->new(lazy => 'very'); -is($lazy_run, 1, "lazy attribute not initialized when an argument is passed to the constructor"); - -ok($object2->has_lazy, "lazy value now"); -is($lazy_run, 1, "lazy attribute not initialized when checked with predicate"); - -is($object2->lazy, 'very', 'value from the constructor'); -is($lazy_run, 1, "lazy coderef not invoked, we already have a value"); - diff --git a/t/001_mouse/013-clearer.t b/t/001_mouse/013-clearer.t deleted file mode 100644 index 973774b..0000000 --- a/t/001_mouse/013-clearer.t +++ /dev/null @@ -1,70 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More tests => 28; - -my $lazy_run = 0; - -do { - package Class; - use Mouse; - - has lazy => ( - is => 'rw', - lazy => 1, - default => sub { ++$lazy_run }, - predicate => 'has_lazy', - clearer => 'clear_lazy', - ); -}; - -can_ok(Class => 'clear_lazy'); - -my $object = Class->new; -is($lazy_run, 0, "lazy attribute not yet initialized"); - -ok(!$object->has_lazy, "no lazy value yet"); -is($lazy_run, 0, "lazy attribute not initialized by predicate"); - -$object->clear_lazy; -is($lazy_run, 0, "lazy attribute not initialized by clearer"); - -ok(!$object->has_lazy, "no lazy value yet"); -is($lazy_run, 0, "lazy attribute not initialized by predicate"); - -is($object->lazy, 1, "lazy value"); -is($lazy_run, 1, "lazy coderef invoked once"); - -ok($object->has_lazy, "lazy value now"); -is($lazy_run, 1, "lazy coderef invoked once"); - -is($object->lazy, 1, "lazy value is cached"); -is($lazy_run, 1, "lazy coderef invoked once"); - -$object->clear_lazy; -is($lazy_run, 1, "lazy coderef not invoked by clearer"); - -ok(!$object->has_lazy, "no value now, clearer removed it"); -is($lazy_run, 1, "lazy attribute not initialized by predicate"); - -is($object->lazy, 2, "new lazy value; previous was cleared"); -is($lazy_run, 2, "lazy coderef invoked twice"); - -my $object2 = Class->new(lazy => 'very'); -is($lazy_run, 2, "lazy attribute not initialized when an argument is passed to the constructor"); - -ok($object2->has_lazy, "lazy value now"); -is($lazy_run, 2, "lazy attribute not initialized when checked with predicate"); - -is($object2->lazy, 'very', 'value from the constructor'); -is($lazy_run, 2, "lazy coderef not invoked, we already have a value"); - -$object2->clear_lazy; -is($lazy_run, 2, "lazy attribute not initialized by clearer"); - -ok(!$object2->has_lazy, "no more lazy value"); -is($lazy_run, 2, "lazy attribute not initialized by predicate"); - -is($object2->lazy, 3, 'new lazy value'); -is($lazy_run, 3, "lazy value re-created"); - diff --git a/t/001_mouse/013-predicate-and-clearer.t b/t/001_mouse/013-predicate-and-clearer.t new file mode 100644 index 0000000..359368d --- /dev/null +++ b/t/001_mouse/013-predicate-and-clearer.t @@ -0,0 +1,77 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Mouse; + +my $lazy_run = 0; + +do { + package Class; + use Mouse; + + has lazy => ( + is => 'rw', + lazy => 1, + default => sub { ++$lazy_run }, + predicate => 'has_lazy', + clearer => 'clear_lazy', + ); +}; + +can_ok(Class => 'clear_lazy'); + +with_immutable(sub{ + + $lazy_run = 0; + my $object = Class->new; + is($lazy_run, 0, "lazy attribute not yet initialized"); + + ok(!$object->has_lazy, "no lazy value yet"); + is($lazy_run, 0, "lazy attribute not initialized by predicate"); + + $object->clear_lazy; + is($lazy_run, 0, "lazy attribute not initialized by clearer"); + + ok(!$object->has_lazy, "no lazy value yet"); + is($lazy_run, 0, "lazy attribute not initialized by predicate"); + + is($object->lazy, 1, "lazy value"); + is($lazy_run, 1, "lazy coderef invoked once"); + + ok($object->has_lazy, "lazy value now"); + is($lazy_run, 1, "lazy coderef invoked once"); + + is($object->lazy, 1, "lazy value is cached"); + is($lazy_run, 1, "lazy coderef invoked once"); + + $object->clear_lazy; + is($lazy_run, 1, "lazy coderef not invoked by clearer"); + + ok(!$object->has_lazy, "no value now, clearer removed it"); + is($lazy_run, 1, "lazy attribute not initialized by predicate"); + + is($object->lazy, 2, "new lazy value; previous was cleared"); + is($lazy_run, 2, "lazy coderef invoked twice"); + + my $object2 = Class->new(lazy => 'very'); + is($lazy_run, 2, "lazy attribute not initialized when an argument is passed to the constructor"); + + ok($object2->has_lazy, "lazy value now"); + is($lazy_run, 2, "lazy attribute not initialized when checked with predicate"); + + is($object2->lazy, 'very', 'value from the constructor'); + is($lazy_run, 2, "lazy coderef not invoked, we already have a value"); + + $object2->clear_lazy; + is($lazy_run, 2, "lazy attribute not initialized by clearer"); + + ok(!$object2->has_lazy, "no more lazy value"); + is($lazy_run, 2, "lazy attribute not initialized by predicate"); + + is($object2->lazy, 3, 'new lazy value'); + is($lazy_run, 3, "lazy value re-created"); + +}, qw(Class)); + +done_testing;