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