version bump
[gitmo/Moose.git] / t / metaclasses / overloading.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More;
5 use Test::Fatal;
6
7 {
8     package Foo;
9     use Moose;
10 }
11
12 {
13     my $meta = Foo->meta;
14
15     ok(!$meta->is_overloaded);
16
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_overload_list], []);
24
25     is_deeply([$meta->get_all_overloaded_operators], []);
26
27     is($meta->get_overloaded_operator('+'), undef);
28     is($meta->get_overloaded_operator('-'), undef);
29 }
30
31 my $plus = 0;
32 my $plus_impl;
33 BEGIN { $plus_impl = sub { $plus = 1; "plus" } }
34 {
35     package Foo::Overloaded;
36     use Moose;
37     use overload '+' => $plus_impl;
38 }
39
40 {
41     my $meta = Foo::Overloaded->meta;
42
43     ok($meta->is_overloaded);
44
45     ok($meta->has_overloaded_operator('+'));
46     ok(!$meta->has_overloaded_operator('-'));
47
48     is_deeply([$meta->get_overload_list], ['+']);
49
50     my @overloads = $meta->get_all_overloaded_operators;
51     is(scalar(@overloads), 1);
52     my $plus_meth = $overloads[0];
53     isa_ok($plus_meth, 'Class::MOP::Method::Overload');
54     is($plus_meth->operator, '+');
55     is($plus_meth->name, '(+');
56     is($plus_meth->body, $plus_impl);
57     is($plus_meth->package_name, 'Foo::Overloaded');
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_overload_list], ['+', '-']);
83
84     is(scalar($meta->get_all_overloaded_operators), 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);
97
98     $meta->remove_overloaded_operator('-');
99
100     like(exception { Foo::Overloaded->new - Foo::Overloaded->new },
101          qr/Operation "-": no method found/);
102 }
103
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
176 done_testing;