X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fmetaclasses%2Foverloading.t;h=ba5f1d5e1e28be4c827314e2201d355884a9a506;hb=702be3d89ea803c8ece85c0bfaccfdff72f6cd0b;hp=c6c3659132de623797fdccdab61b498e23b3c96a;hpb=2683d371fec5a97c460fee1a8d03339e30c8667d;p=gitmo%2FMoose.git diff --git a/t/metaclasses/overloading.t b/t/metaclasses/overloading.t index c6c3659..ba5f1d5 100644 --- a/t/metaclasses/overloading.t +++ b/t/metaclasses/overloading.t @@ -2,6 +2,7 @@ use strict; use warnings; use Test::More; +use Test::Fatal; { package Foo; @@ -9,13 +10,27 @@ use Test::More; } { - is_deeply([Foo->meta->get_overload_list], []); - is_deeply([Foo->meta->get_overloaded_ops], []); + my $meta = Foo->meta; + + ok(!$meta->is_overloaded); + + is_deeply([sort $meta->overload_operators], + [sort map { split /\s+/ } values %overload::ops]); + + ok(!$meta->has_overloaded_operator('+')); + ok(!$meta->has_overloaded_operator('-')); + + is_deeply([$meta->get_overload_list], []); + + is_deeply([$meta->get_all_overloaded_operators], []); + + is($meta->get_overloaded_operator('+'), undef); + is($meta->get_overloaded_operator('-'), undef); } -my $plus; +my $plus = 0; my $plus_impl; -BEGIN { $plus_impl = sub { $plus = 1; $_[0] + $_[1] } } +BEGIN { $plus_impl = sub { $plus = 1; "plus" } } { package Foo::Overloaded; use Moose; @@ -23,16 +38,67 @@ BEGIN { $plus_impl = sub { $plus = 1; $_[0] + $_[1] } } } { - is_deeply([Foo::Overloaded->meta->get_overloaded_ops], ['+']); - my @overloads = Foo::Overloaded->meta->get_overload_list; + my $meta = Foo::Overloaded->meta; + + ok($meta->is_overloaded); + + ok($meta->has_overloaded_operator('+')); + ok(!$meta->has_overloaded_operator('-')); + + is_deeply([$meta->get_overload_list], ['+']); + + my @overloads = $meta->get_all_overloaded_operators; is(scalar(@overloads), 1); my $plus_meth = $overloads[0]; isa_ok($plus_meth, 'Class::MOP::Method::Overload'); - is($plus_meth->op, '+'); + is($plus_meth->operator, '+'); is($plus_meth->name, '(+'); is($plus_meth->body, $plus_impl); is($plus_meth->package_name, 'Foo::Overloaded'); - is($plus_meth->associated_metaclass, Foo::Overloaded->meta); + is($plus_meth->associated_metaclass, $meta); + + my $plus_meth2 = $meta->get_overloaded_operator('+'); + { local $TODO = "we don't cache these yet"; + is($plus_meth2, $plus_meth); + } + is($plus_meth2->operator, '+'); + is($plus_meth2->body, $plus_impl); + is($meta->get_overloaded_operator('-'), undef); + + is($plus, 0); + is(Foo::Overloaded->new + Foo::Overloaded->new, "plus"); + is($plus, 1); + + my $minus = 0; + my $minus_impl = sub { $minus = 1; "minus" }; + + like(exception { Foo::Overloaded->new - Foo::Overloaded->new }, + qr/Operation "-": no method found/); + + $meta->add_overloaded_operator('-' => $minus_impl); + + ok($meta->has_overloaded_operator('-')); + + is_deeply([sort $meta->get_overload_list], ['+', '-']); + + is(scalar($meta->get_all_overloaded_operators), 2); + + my $minus_meth = $meta->get_overloaded_operator('-'); + isa_ok($minus_meth, 'Class::MOP::Method::Overload'); + is($minus_meth->operator, '-'); + is($minus_meth->name, '(-'); + is($minus_meth->body, $minus_impl); + is($minus_meth->package_name, 'Foo::Overloaded'); + is($minus_meth->associated_metaclass, $meta); + + is($minus, 0); + is(Foo::Overloaded->new - Foo::Overloaded->new, "minus"); + is($minus, 1); + + $meta->remove_overloaded_operator('-'); + + like(exception { Foo::Overloaded->new - Foo::Overloaded->new }, + qr/Operation "-": no method found/); } done_testing;