diff --git a/t/lib/Mo/handles.t b/t/lib/Mo/handles.t index e8f74ccc..653c396f 100644 --- a/t/lib/Mo/handles.t +++ b/t/lib/Mo/handles.t @@ -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 $@; diff --git a/t/lib/Mo/isa.t b/t/lib/Mo/isa.t index e6a56e8f..39e4e19c 100644 --- a/t/lib/Mo/isa.t +++ b/t/lib/Mo/isa.t @@ -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: