From: gfx Date: Wed, 7 Oct 2009 09:48:48 +0000 (+0900) Subject: Improve tests X-Git-Tag: 0.37_03~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=66e667af8fad903adf5064bdcf5d09f719429f65 Improve tests --- diff --git a/t/008-default.t b/t/008-default.t index 6fc4c20..f77d01b 100644 --- a/t/008-default.t +++ b/t/008-default.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 18; +use Test::More tests => 36; do { package Class; @@ -22,29 +22,32 @@ do { ); }; -my $object = Class->new; -is($object->x, 10, "attribute has a default of 10"); -is($object->y, 20, "attribute has a default of 20"); -is($object->z, undef, "attribute has no default"); +for(1 .. 2){ + my $object = Class->new; + is($object->x, 10, "attribute has a default of 10"); + is($object->y, 20, "attribute has a default of 20"); + is($object->z, undef, "attribute has no default"); -is($object->x(5), 5, "setting a new value"); -is($object->y(25), 25, "setting a new value"); -is($object->z(125), 125, "setting a new value"); + is($object->x(5), 5, "setting a new value"); + is($object->y(25), 25, "setting a new value"); + is($object->z(125), 125, "setting a new value"); -is($object->x, 5, "setting a new value does not trigger default"); -is($object->y, 25, "setting a new value does not trigger default"); -is($object->z, 125, "setting a new value does not trigger default"); + is($object->x, 5, "setting a new value does not trigger default"); + is($object->y, 25, "setting a new value does not trigger default"); + is($object->z, 125, "setting a new value does not trigger default"); -my $object2 = Class->new(x => 50); -is($object2->x, 50, "attribute was initialized to 50"); -is($object2->y, 20, "attribute has a default of 20"); -is($object2->z, undef, "attribute has no default"); + my $object2 = Class->new(x => 50); + is($object2->x, 50, "attribute was initialized to 50"); + is($object2->y, 20, "attribute has a default of 20"); + is($object2->z, undef, "attribute has no default"); -is($object2->x(5), 5, "setting a new value"); -is($object2->y(25), 25, "setting a new value"); -is($object2->z(125), 125, "setting a new value"); + is($object2->x(5), 5, "setting a new value"); + is($object2->y(25), 25, "setting a new value"); + is($object2->z(125), 125, "setting a new value"); -is($object2->x, 5, "setting a new value does not trigger default"); -is($object2->y, 25, "setting a new value does not trigger default"); -is($object2->z, 125, "setting a new value does not trigger default"); + is($object2->x, 5, "setting a new value does not trigger default"); + is($object2->y, 25, "setting a new value does not trigger default"); + is($object2->z, 125, "setting a new value does not trigger default"); + Class->meta->make_immutable; +} diff --git a/t/022-init-arg.t b/t/022-init-arg.t index 9546e3d..bc0d639 100644 --- a/t/022-init-arg.t +++ b/t/022-init-arg.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 11; +use Test::More tests => 20; do { package Class; @@ -13,38 +13,34 @@ do { init_arg => 'key', default => 'default', ); -}; - -my $object = Class->new; -is($object->name, 'default', 'accessor uses attribute name'); -is($object->{key}, undef, 'nothing in object->{init_arg}!'); -is($object->{name}, 'default', 'value is in object->{name}'); - -my $object2 = Class->new(name => 'name', key => 'key'); -is($object2->name, 'key', 'attribute value is from name'); -is($object2->{key}, undef, 'no value for the init_arg'); -is($object2->{name}, 'key', 'value is in key from name'); - -my $attr = $object2->meta->get_attribute('name'); -ok($attr, 'got the attribute object by name (not init_arg)'); -is($attr->name, 'name', 'name is name'); -is($attr->init_arg, 'key', 'init_arg is key'); - -do { - package Foo; - use Mouse; - has name => ( + has no_init_arg => ( is => 'rw', + isa => 'Str', init_arg => undef, default => 'default', ); + }; -my $foo = Foo->new(name => 'joe'); -is($foo->name, 'default', 'init_arg => undef ignores attribute name in the constructor'); +for('mutable', 'immutable'){ + my $object = Class->new; + is($object->name, 'default', "accessor uses attribute name ($_)"); + is($object->{key}, undef, 'nothing in object->{init_arg}!'); + is($object->{name}, 'default', 'value is in object->{name}'); + + my $object2 = Class->new(name => 'name', key => 'key'); + is($object2->name, 'key', 'attribute value is from name'); + is($object2->{key}, undef, 'no value for the init_arg'); + is($object2->{name}, 'key', 'value is in key from name'); + + my $attr = $object2->meta->get_attribute('name'); + ok($attr, 'got the attribute object by name (not init_arg)'); + is($attr->name, 'name', 'name is name'); + is($attr->init_arg, 'key', 'init_arg is key'); -Foo->meta->make_immutable; + my $object3 = Class->new(no_init_arg => 'joe'); + is($object3->no_init_arg, 'default', 'init_arg => undef ignores attribute name in the constructor'); -my $bar = Foo->new(name => 'joe'); -is($bar->name, 'default', 'init_arg => undef ignores attribute name in the inlined constructor'); + Class->meta->make_immutable; +}