Mo tests: Give everything a unique name

This commit is contained in:
Brian Fraser
2012-07-19 18:38:35 -03:00
parent d8cef2e902
commit adc02c767c
2 changed files with 109 additions and 47 deletions

View File

@@ -185,9 +185,9 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
can_ok($baz_proxy, 'bar');
can_ok($baz_proxy, 'boo');
is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
is($baz_proxy->foo, 'Baz::foo', '... ->foo got the right proxied return value');
is($baz_proxy->bar, 'Baz::bar', '... ->bar got the right proxied return value');
is($baz_proxy->boo, 'Baz::boo', '... ->boo got the right proxied return value');
}
{
my $baz_proxy = Baz::Proxy2->new;
@@ -199,8 +199,8 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
can_ok($baz_proxy, 'foo');
can_ok($baz_proxy, 'boo');
is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
is($baz_proxy->foo, 'Baz::foo', '... ->foo got the right proxied return value');
is($baz_proxy->boo, 'Baz::boo', '... ->boo got the right proxied return value');
}
{
my $baz_proxy = Baz::Proxy3->new;
@@ -212,8 +212,8 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
can_ok($baz_proxy, 'bar');
can_ok($baz_proxy, 'boo');
is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
is($baz_proxy->bar, 'Baz::bar', '... ->bar got the right proxied return value');
is($baz_proxy->boo, 'Baz::boo', '... ->boo got the right proxied return value');
}
# -------------------------------------------------------------------
@@ -349,8 +349,8 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
# and make sure the delegation picks it up
is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
is($bar->foo->bar, 30, '... bar->foo->bar returned the value changed by ->foo->bar()');
is($bar->foo_bar, 30, '... bar->foo_bar getter delegated correctly');
# change the value through the delegation ...
@@ -358,8 +358,8 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
# and make sure everyone sees it
is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
is($bar->foo->bar, 50, '... bar->foo->bar returned the value changed by ->foo_bar()');
is($bar->foo_bar, 50, '... bar->foo_bar getter delegated correctly');
# change the object we are delegating too
@@ -432,12 +432,12 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop');
my $i = Bar->new(foo => undef);
local $@;
eval { $i->foo_bar };
like($@, qr/is not defined/, 'useful error from unblessed reference' );
like($@, qr/is not defined/, 'useful error if delegating from undef' );
my $j = Bar->new(foo => []);
local $@;
eval { $j->foo_bar };
like($@, qr/is not an object \(got 'ARRAY/, 'useful error from unblessed reference' );
like($@, qr/is not an object \(got 'ARRAY/, '... or from an unblessed reference' );
my $k = Bar->new(foo => "Foo");
local $@;

View File

@@ -40,67 +40,129 @@ package main;
my $foo = Foo::isa->new( myStr => "abcdefg" );
# Bool:
lives_ok { ok !$foo->myBool(undef) } "Bool attr set to undef";
lives_ok { is $foo->myBool(1), 1 } "Bool attr set to 1";
lives_ok {
ok !defined($foo->myBool(undef)),
"myBool set to undef"
} "Bool attr set to undef";
lives_ok {
is $foo->myBool(1), 1,
"myBool set to 1"
} "Bool attr set to 1";
is $foo->myBool, 1, "new value of \$foo->myBool as expected";
lives_ok { is $foo->myBool(1e0), 1 } "Bool attr set to 1e0";
lives_ok {
is $foo->myBool(1e0), 1,
"myBool set to 1e0 becomes 1"
} "Bool attr set to 1e0";
dies_ok { $foo->myBool("1f0") } "Bool attr set to 1f0 dies";
lives_ok { is $foo->myBool(""), "" } "Bool attr set to empty string";
lives_ok {
is $foo->myBool(""), "",
"myBool set to an emptry string"
} "Bool attr set to empty string";
is $foo->myBool, "", "new value of \$foo->myBool as expected";
lives_ok { is $foo->myBool(0), 0 } "Bool attr set to 0";
lives_ok { is $foo->myBool(0.0), 0 } "Bool attr set to 0.0";
lives_ok { is $foo->myBool(0e0), 0 } "Bool attr set to 0e0";
lives_ok {
is $foo->myBool(0), 0,
"myBool set to 0"
} "Bool attr set to 0";
lives_ok {
is $foo->myBool(0.0), 0,
"myBool set to 0.0 becomes 0"
} "Bool attr set to 0.0";
lives_ok {
is $foo->myBool(0e0), 0,
"myBool set to 0e0 becomes 0"
} "Bool attr set to 0e0";
dies_ok { $foo->myBool("0.0") } "Bool attr set to stringy 0.0 dies";
# Bool tests from Mouse:
open(my $FH, "<", $0) or die "Could not open $0 for the test";
my $msg = q(Bool rejects anything which is not a 1 or 0 or "" or undef");
lives_ok { $foo->myBool(0) } $msg;
lives_ok { $foo->myBool(1) } $msg;
dies_ok { $foo->myBool(100) } $msg;
lives_ok { $foo->myBool("") } $msg;
dies_ok { $foo->myBool("Foo") } $msg;
dies_ok { $foo->myBool([]) } $msg;
dies_ok { $foo->myBool({}) } $msg;
dies_ok { $foo->myBool(sub {}) } $msg;
dies_ok { $foo->myBool(\"") } $msg;
dies_ok { $foo->myBool(*STDIN) } $msg;
dies_ok { $foo->myBool(\*STDIN) } $msg;
dies_ok { $foo->myBool($FH) } $msg;
dies_ok { $foo->myBool(qr/../) } $msg;
dies_ok { $foo->myBool(bless {}, "Foo") } $msg;
lives_ok { $foo->myBool(undef) } $msg;
# Bool rejects anything which is not a 1 or 0 or "" or undef:
lives_ok { $foo->myBool(0) } "Bool lives with 0";
lives_ok { $foo->myBool(1) } "Bool lives with 1";
dies_ok { $foo->myBool(100) } "Bool dies with 100";
lives_ok { $foo->myBool("") } "Bool lives with ''";
dies_ok { $foo->myBool("Foo") } "Bool dies with a string";
dies_ok { $foo->myBool([]) } "Bool dies with an arrayref";
dies_ok { $foo->myBool({}) } "Bool dies with a hashref";
dies_ok { $foo->myBool(sub {}) } "Bool dies with a coderef";
dies_ok { $foo->myBool(\"") } "Bool dies with a scalar ref";
dies_ok { $foo->myBool(*STDIN) } "Bool dies with a glob";
dies_ok { $foo->myBool(\*STDIN) } "Bool dies with a globref";
dies_ok { $foo->myBool($FH) } "Bool dies with a lexical filehandle";
dies_ok { $foo->myBool(qr/../) } "Bool dies with a regex";
dies_ok { $foo->myBool(bless {}, "Foo") } "Bool dies with an object";
lives_ok { $foo->myBool(undef) } "Bool lives with undef";
# Num:
lives_ok { is $foo->myNum(5.5), 5.5 } "Num attr set to decimal";
lives_ok {
is $foo->myNum(5.5),
5.5,
"myNum was set to 5.5"
} "Num attr set to decimal";
is $foo->myNum, 5.5, "new value of \$foo->myNum as expected";
lives_ok { is $foo->myNum(5), 5 } "Num attr set to integer";
lives_ok { is $foo->myNum(5e0), 5 } "Num attr set to 5e0";
lives_ok {
is $foo->myNum(5),
5,
"myNum was set to 5"
} "Num attr set to integer";
lives_ok {
is $foo->myNum(5e0),
5,
"myNum was set to 5e0"
} "Num attr set to 5e0";
dies_ok { $foo->myBool("5f0") } "Bool attr set to 5f0 dies";
lives_ok { is $foo->myNum("5.5"), 5.5 } "Num attr set to stringy decimal";
lives_ok {
is $foo->myNum("5.5"),
5.5,
"myNum was set to q<5.5>"
} "Num attr set to stringy decimal";
# Int:
lives_ok { is $foo->myInt(0), 0 } "Int attr set to 0";
lives_ok { is $foo->myInt(1), 1 } "Int attr set to 1";
lives_ok { is $foo->myInt(1e0), 1 } "Int attr set to 1e0";
lives_ok {
is $foo->myInt(0),
0,
"myInt was set to 0"
} "Int attr set to 0";
lives_ok {
is $foo->myInt(1),
1,
"myInt was set to 1"
} "Int attr set to 1";
lives_ok {
is $foo->myInt(1e0),
1,
"myInt was set to 1e0"
} "Int attr set to 1e0";
is $foo->myInt, 1, "new value of \$foo->myInt as expected";
dies_ok { $foo->myInt("") } "Int attr set to empty string dies";
dies_ok { $foo->myInt(5.5) } "Int attr set to decimal dies";
# Str:
is $foo->myStr, "abcdefg", "Str passed to constructor accepted";
lives_ok { is $foo->myStr("hijklmn"), "hijklmn" } "Str attr set to a string";
lives_ok {
is $foo->myStr("hijklmn"), "hijklmn",
"myStr was set to a string",
} "Str attr set to a string";
is $foo->myStr, "hijklmn", "new value of \$foo->myStr as expected";
lives_ok { is $foo->myStr(5.5), 5.5 } "Str attr set to a decimal value";
lives_ok {
is $foo->myStr(5.5), 5.5,
"myStr was set to 5.5"
} "Str attr set to a decimal value";
# Class instance:
lives_ok { is $foo->myFoo($foo), $foo } "Class instance attr set to self";
lives_ok {
is $foo->myFoo($foo), $foo,
"myFoo set to self"
} "Class instance attr set to self";
isa_ok $foo->myFoo, "Foo::isa", "new value of \$foo->myFoo as expected";
dies_ok { $foo->myFoo({}) } "Class instance attr set to hash dies";
# Class name:
my $class = ref($foo);
lives_ok { is $foo->myFoo($class), $class } "Class instance attr set to classname";
lives_ok {
is $foo->myFoo($class),
$class,
"myFoo set to a classname"
} "Class instance attr set to classname";
is $foo->myFoo, $class, "new value of \$foo->myFoo as expected";
# Refs: