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 | |
889822da |
7 | my $quote = qr/['`"]/; |
8 | |
2683d371 |
9 | { |
10 | package Foo; |
11 | use Moose; |
12 | } |
13 | |
14 | { |
4a0bc88f |
15 | my $meta = Foo->meta; |
16 | |
c18e272e |
17 | ok(!$meta->is_overloaded); |
18 | |
4a0bc88f |
19 | is_deeply([sort $meta->overload_operators], |
20 | [sort map { split /\s+/ } values %overload::ops]); |
21 | |
22 | ok(!$meta->has_overloaded_operator('+')); |
23 | ok(!$meta->has_overloaded_operator('-')); |
24 | |
4a0bc88f |
25 | is_deeply([$meta->get_overload_list], []); |
26 | |
87a1f36e |
27 | is_deeply([$meta->get_all_overloaded_operators], []); |
28 | |
4a0bc88f |
29 | is($meta->get_overloaded_operator('+'), undef); |
30 | is($meta->get_overloaded_operator('-'), undef); |
2683d371 |
31 | } |
32 | |
4a0bc88f |
33 | my $plus = 0; |
2683d371 |
34 | my $plus_impl; |
4a0bc88f |
35 | BEGIN { $plus_impl = sub { $plus = 1; "plus" } } |
2683d371 |
36 | { |
37 | package Foo::Overloaded; |
38 | use Moose; |
39 | use overload '+' => $plus_impl; |
40 | } |
41 | |
42 | { |
4a0bc88f |
43 | my $meta = Foo::Overloaded->meta; |
44 | |
c18e272e |
45 | ok($meta->is_overloaded); |
46 | |
4a0bc88f |
47 | ok($meta->has_overloaded_operator('+')); |
48 | ok(!$meta->has_overloaded_operator('-')); |
49 | |
87a1f36e |
50 | is_deeply([$meta->get_overload_list], ['+']); |
4a0bc88f |
51 | |
87a1f36e |
52 | my @overloads = $meta->get_all_overloaded_operators; |
2683d371 |
53 | is(scalar(@overloads), 1); |
54 | my $plus_meth = $overloads[0]; |
55 | isa_ok($plus_meth, 'Class::MOP::Method::Overload'); |
644d6eaa |
56 | is($plus_meth->operator, '+'); |
2683d371 |
57 | is($plus_meth->name, '(+'); |
58 | is($plus_meth->body, $plus_impl); |
59 | is($plus_meth->package_name, 'Foo::Overloaded'); |
4a0bc88f |
60 | is($plus_meth->associated_metaclass, $meta); |
61 | |
62 | my $plus_meth2 = $meta->get_overloaded_operator('+'); |
63 | { local $TODO = "we don't cache these yet"; |
64 | is($plus_meth2, $plus_meth); |
65 | } |
66 | is($plus_meth2->operator, '+'); |
67 | is($plus_meth2->body, $plus_impl); |
68 | is($meta->get_overloaded_operator('-'), undef); |
69 | |
70 | is($plus, 0); |
71 | is(Foo::Overloaded->new + Foo::Overloaded->new, "plus"); |
72 | is($plus, 1); |
73 | |
74 | my $minus = 0; |
75 | my $minus_impl = sub { $minus = 1; "minus" }; |
76 | |
77 | like(exception { Foo::Overloaded->new - Foo::Overloaded->new }, |
889822da |
78 | qr/Operation $quote-$quote: no method found/); |
4a0bc88f |
79 | |
80 | $meta->add_overloaded_operator('-' => $minus_impl); |
81 | |
82 | ok($meta->has_overloaded_operator('-')); |
83 | |
87a1f36e |
84 | is_deeply([sort $meta->get_overload_list], ['+', '-']); |
4a0bc88f |
85 | |
87a1f36e |
86 | is(scalar($meta->get_all_overloaded_operators), 2); |
4a0bc88f |
87 | |
88 | my $minus_meth = $meta->get_overloaded_operator('-'); |
89 | isa_ok($minus_meth, 'Class::MOP::Method::Overload'); |
90 | is($minus_meth->operator, '-'); |
91 | is($minus_meth->name, '(-'); |
92 | is($minus_meth->body, $minus_impl); |
93 | is($minus_meth->package_name, 'Foo::Overloaded'); |
94 | is($minus_meth->associated_metaclass, $meta); |
95 | |
96 | is($minus, 0); |
97 | is(Foo::Overloaded->new - Foo::Overloaded->new, "minus"); |
98 | is($minus, 1); |
702be3d8 |
99 | |
100 | $meta->remove_overloaded_operator('-'); |
101 | |
102 | like(exception { Foo::Overloaded->new - Foo::Overloaded->new }, |
889822da |
103 | qr/Operation $quote-$quote: no method found/); |
2683d371 |
104 | } |
105 | |
996f5e95 |
106 | my $times = 0; |
107 | my $divided = 0; |
108 | { |
109 | package Foo::OverloadedMethod; |
110 | use Moose; |
111 | use overload '*' => 'times'; |
112 | |
113 | sub times { $times = 1; "times" } |
114 | sub divided { $divided = 1; "divided" } |
115 | } |
116 | |
117 | { |
118 | my $meta = Foo::OverloadedMethod->meta; |
119 | |
120 | ok($meta->is_overloaded); |
121 | |
122 | ok($meta->has_overloaded_operator('*')); |
123 | ok(!$meta->has_overloaded_operator('/')); |
124 | |
125 | is_deeply([$meta->get_overload_list], ['*']); |
126 | |
127 | my @overloads = $meta->get_all_overloaded_operators; |
128 | is(scalar(@overloads), 1); |
129 | my $times_meth = $overloads[0]; |
130 | isa_ok($times_meth, 'Class::MOP::Method::Overload'); |
131 | is($times_meth->operator, '*'); |
132 | is($times_meth->name, '(*'); |
133 | is($times_meth->body, $meta->get_method('times')->body); |
134 | is($times_meth->package_name, 'Foo::OverloadedMethod'); |
135 | is($times_meth->associated_metaclass, $meta); |
136 | |
137 | my $times_meth2 = $meta->get_overloaded_operator('*'); |
138 | { local $TODO = "we don't cache these yet"; |
139 | is($times_meth2, $times_meth); |
140 | } |
141 | is($times_meth2->operator, '*'); |
142 | is($times_meth2->body, $meta->get_method('times')->body); |
143 | is($meta->get_overloaded_operator('/'), undef); |
144 | |
145 | is($times, 0); |
146 | is(Foo::OverloadedMethod->new * Foo::OverloadedMethod->new, "times"); |
147 | is($times, 1); |
148 | |
149 | like(exception { Foo::OverloadedMethod->new / Foo::OverloadedMethod->new }, |
889822da |
150 | qr{Operation $quote/$quote: no method found}); |
996f5e95 |
151 | |
152 | $meta->add_overloaded_operator('/' => 'divided'); |
153 | |
154 | ok($meta->has_overloaded_operator('/')); |
155 | |
156 | is_deeply([sort $meta->get_overload_list], ['*', '/']); |
157 | |
158 | is(scalar($meta->get_all_overloaded_operators), 2); |
159 | |
160 | my $divided_meth = $meta->get_overloaded_operator('/'); |
161 | isa_ok($divided_meth, 'Class::MOP::Method::Overload'); |
162 | is($divided_meth->operator, '/'); |
163 | is($divided_meth->name, '(/'); |
164 | is($divided_meth->body, $meta->get_method('divided')->body); |
165 | is($divided_meth->package_name, 'Foo::OverloadedMethod'); |
166 | is($divided_meth->associated_metaclass, $meta); |
167 | |
168 | is($divided, 0); |
169 | is(Foo::OverloadedMethod->new / Foo::OverloadedMethod->new, "divided"); |
170 | is($divided, 1); |
171 | |
172 | $meta->remove_overloaded_operator('/'); |
173 | |
174 | like(exception { Foo::OverloadedMethod->new / Foo::OverloadedMethod->new }, |
889822da |
175 | qr{Operation $quote/$quote: no method found}); |
996f5e95 |
176 | } |
177 | |
2683d371 |
178 | done_testing; |