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 my $quote = qr/['`"]/;
   8
   9 {
  10     package Foo;
  11     use Moose;
  12 }
  13
  14 {
  15     my $meta = Foo->meta;
  16
  17     ok(!$meta->is_overloaded);
  18
  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
  25     is_deeply([$meta->get_overload_list], []);
  26
  27     is_deeply([$meta->get_all_overloaded_operators], []);
  28
  29     is($meta->get_overloaded_operator('+'), undef);
  30     is($meta->get_overloaded_operator('-'), undef);
  31 }
  32
  33 my $plus = 0;
  34 my $plus_impl;
  35 BEGIN { $plus_impl = sub { $plus = 1; "plus" } }
  36 {
  37     package Foo::Overloaded;
  38     use Moose;
  39     use overload '+' => $plus_impl;
  40 }
  41
  42 {
  43     my $meta = Foo::Overloaded->meta;
  44
  45     ok($meta->is_overloaded);
  46
  47     ok($meta->has_overloaded_operator('+'));
  48     ok(!$meta->has_overloaded_operator('-'));
  49
  50     is_deeply([$meta->get_overload_list], ['+']);
  51
  52     my @overloads = $meta->get_all_overloaded_operators;
  53     is(scalar(@overloads), 1);
  54     my $plus_meth = $overloads[0];
  55     isa_ok($plus_meth, 'Class::MOP::Method::Overload');
  56     is($plus_meth->operator, '+');
  57     is($plus_meth->name, '(+');
  58     is($plus_meth->body, $plus_impl);
  59     is($plus_meth->package_name, 'Foo::Overloaded');
  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 },
  78          qr/Operation $quote-$quote: no method found/);
  79
  80     $meta->add_overloaded_operator('-' => $minus_impl);
  81
  82     ok($meta->has_overloaded_operator('-'));
  83
  84     is_deeply([sort $meta->get_overload_list], ['+', '-']);
  85
  86     is(scalar($meta->get_all_overloaded_operators), 2);
  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);
  99
 100     $meta->remove_overloaded_operator('-');
 101
 102     like(exception { Foo::Overloaded->new - Foo::Overloaded->new },
 103          qr/Operation $quote-$quote: no method found/);
 104 }
 105
 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 },
 150          qr{Operation $quote/$quote: no method found});
 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 },
 175          qr{Operation $quote/$quote: no method found});
 176 }
 177
 178 done_testing;