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;