Commit | Line | Data |
2683d371 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
4a0bc88f |
5 | use Test::Fatal; |
2683d371 |
6 | |
7 | { |
8 | package Foo; |
9 | use Moose; |
10 | } |
11 | |
12 | { |
4a0bc88f |
13 | my $meta = Foo->meta; |
14 | |
c18e272e |
15 | ok(!$meta->is_overloaded); |
16 | |
4a0bc88f |
17 | is_deeply([sort $meta->overload_operators], |
18 | [sort map { split /\s+/ } values %overload::ops]); |
19 | |
20 | ok(!$meta->has_overloaded_operator('+')); |
21 | ok(!$meta->has_overloaded_operator('-')); |
22 | |
23 | is_deeply([$meta->get_overloaded_operators], []); |
24 | |
25 | is_deeply([$meta->get_overload_list], []); |
26 | |
27 | is($meta->get_overloaded_operator('+'), undef); |
28 | is($meta->get_overloaded_operator('-'), undef); |
2683d371 |
29 | } |
30 | |
4a0bc88f |
31 | my $plus = 0; |
2683d371 |
32 | my $plus_impl; |
4a0bc88f |
33 | BEGIN { $plus_impl = sub { $plus = 1; "plus" } } |
2683d371 |
34 | { |
35 | package Foo::Overloaded; |
36 | use Moose; |
37 | use overload '+' => $plus_impl; |
38 | } |
39 | |
40 | { |
4a0bc88f |
41 | my $meta = Foo::Overloaded->meta; |
42 | |
c18e272e |
43 | ok($meta->is_overloaded); |
44 | |
4a0bc88f |
45 | ok($meta->has_overloaded_operator('+')); |
46 | ok(!$meta->has_overloaded_operator('-')); |
47 | |
48 | is_deeply([$meta->get_overloaded_operators], ['+']); |
49 | |
50 | my @overloads = $meta->get_overload_list; |
2683d371 |
51 | is(scalar(@overloads), 1); |
52 | my $plus_meth = $overloads[0]; |
53 | isa_ok($plus_meth, 'Class::MOP::Method::Overload'); |
644d6eaa |
54 | is($plus_meth->operator, '+'); |
2683d371 |
55 | is($plus_meth->name, '(+'); |
56 | is($plus_meth->body, $plus_impl); |
57 | is($plus_meth->package_name, 'Foo::Overloaded'); |
4a0bc88f |
58 | is($plus_meth->associated_metaclass, $meta); |
59 | |
60 | my $plus_meth2 = $meta->get_overloaded_operator('+'); |
61 | { local $TODO = "we don't cache these yet"; |
62 | is($plus_meth2, $plus_meth); |
63 | } |
64 | is($plus_meth2->operator, '+'); |
65 | is($plus_meth2->body, $plus_impl); |
66 | is($meta->get_overloaded_operator('-'), undef); |
67 | |
68 | is($plus, 0); |
69 | is(Foo::Overloaded->new + Foo::Overloaded->new, "plus"); |
70 | is($plus, 1); |
71 | |
72 | my $minus = 0; |
73 | my $minus_impl = sub { $minus = 1; "minus" }; |
74 | |
75 | like(exception { Foo::Overloaded->new - Foo::Overloaded->new }, |
76 | qr/Operation "-": no method found/); |
77 | |
78 | $meta->add_overloaded_operator('-' => $minus_impl); |
79 | |
80 | ok($meta->has_overloaded_operator('-')); |
81 | |
82 | is_deeply([sort $meta->get_overloaded_operators], ['+', '-']); |
83 | |
84 | is(scalar($meta->get_overload_list), 2); |
85 | |
86 | my $minus_meth = $meta->get_overloaded_operator('-'); |
87 | isa_ok($minus_meth, 'Class::MOP::Method::Overload'); |
88 | is($minus_meth->operator, '-'); |
89 | is($minus_meth->name, '(-'); |
90 | is($minus_meth->body, $minus_impl); |
91 | is($minus_meth->package_name, 'Foo::Overloaded'); |
92 | is($minus_meth->associated_metaclass, $meta); |
93 | |
94 | is($minus, 0); |
95 | is(Foo::Overloaded->new - Foo::Overloaded->new, "minus"); |
96 | is($minus, 1); |
2683d371 |
97 | } |
98 | |
99 | done_testing; |