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 | |
4a0bc88f |
23 | is_deeply([$meta->get_overload_list], []); |
24 | |
87a1f36e |
25 | is_deeply([$meta->get_all_overloaded_operators], []); |
26 | |
4a0bc88f |
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 | |
87a1f36e |
48 | is_deeply([$meta->get_overload_list], ['+']); |
4a0bc88f |
49 | |
87a1f36e |
50 | my @overloads = $meta->get_all_overloaded_operators; |
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 | |
87a1f36e |
82 | is_deeply([sort $meta->get_overload_list], ['+', '-']); |
4a0bc88f |
83 | |
87a1f36e |
84 | is(scalar($meta->get_all_overloaded_operators), 2); |
4a0bc88f |
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); |
702be3d8 |
97 | |
98 | $meta->remove_overloaded_operator('-'); |
99 | |
100 | like(exception { Foo::Overloaded->new - Foo::Overloaded->new }, |
101 | qr/Operation "-": no method found/); |
2683d371 |
102 | } |
103 | |
996f5e95 |
104 | my $times = 0; |
105 | my $divided = 0; |
106 | { |
107 | package Foo::OverloadedMethod; |
108 | use Moose; |
109 | use overload '*' => 'times'; |
110 | |
111 | sub times { $times = 1; "times" } |
112 | sub divided { $divided = 1; "divided" } |
113 | } |
114 | |
115 | { |
116 | my $meta = Foo::OverloadedMethod->meta; |
117 | |
118 | ok($meta->is_overloaded); |
119 | |
120 | ok($meta->has_overloaded_operator('*')); |
121 | ok(!$meta->has_overloaded_operator('/')); |
122 | |
123 | is_deeply([$meta->get_overload_list], ['*']); |
124 | |
125 | my @overloads = $meta->get_all_overloaded_operators; |
126 | is(scalar(@overloads), 1); |
127 | my $times_meth = $overloads[0]; |
128 | isa_ok($times_meth, 'Class::MOP::Method::Overload'); |
129 | is($times_meth->operator, '*'); |
130 | is($times_meth->name, '(*'); |
131 | is($times_meth->body, $meta->get_method('times')->body); |
132 | is($times_meth->package_name, 'Foo::OverloadedMethod'); |
133 | is($times_meth->associated_metaclass, $meta); |
134 | |
135 | my $times_meth2 = $meta->get_overloaded_operator('*'); |
136 | { local $TODO = "we don't cache these yet"; |
137 | is($times_meth2, $times_meth); |
138 | } |
139 | is($times_meth2->operator, '*'); |
140 | is($times_meth2->body, $meta->get_method('times')->body); |
141 | is($meta->get_overloaded_operator('/'), undef); |
142 | |
143 | is($times, 0); |
144 | is(Foo::OverloadedMethod->new * Foo::OverloadedMethod->new, "times"); |
145 | is($times, 1); |
146 | |
147 | like(exception { Foo::OverloadedMethod->new / Foo::OverloadedMethod->new }, |
148 | qr{Operation "/": no method found}); |
149 | |
150 | $meta->add_overloaded_operator('/' => 'divided'); |
151 | |
152 | ok($meta->has_overloaded_operator('/')); |
153 | |
154 | is_deeply([sort $meta->get_overload_list], ['*', '/']); |
155 | |
156 | is(scalar($meta->get_all_overloaded_operators), 2); |
157 | |
158 | my $divided_meth = $meta->get_overloaded_operator('/'); |
159 | isa_ok($divided_meth, 'Class::MOP::Method::Overload'); |
160 | is($divided_meth->operator, '/'); |
161 | is($divided_meth->name, '(/'); |
162 | is($divided_meth->body, $meta->get_method('divided')->body); |
163 | is($divided_meth->package_name, 'Foo::OverloadedMethod'); |
164 | is($divided_meth->associated_metaclass, $meta); |
165 | |
166 | is($divided, 0); |
167 | is(Foo::OverloadedMethod->new / Foo::OverloadedMethod->new, "divided"); |
168 | is($divided, 1); |
169 | |
170 | $meta->remove_overloaded_operator('/'); |
171 | |
172 | like(exception { Foo::OverloadedMethod->new / Foo::OverloadedMethod->new }, |
173 | qr{Operation "/": no method found}); |
174 | } |
175 | |
2683d371 |
176 | done_testing; |