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     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);
  27 }
  28
  29 my $plus = 0;
  30 my $plus_impl;
  31 BEGIN { $plus_impl = sub { $plus = 1; "plus" } }
  32 {
  33     package Foo::Overloaded;
  34     use Moose;
  35     use overload '+' => $plus_impl;
  36 }
  37
  38 {
  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;
  47     is(scalar(@overloads), 1);
  48     my $plus_meth = $overloads[0];
  49     isa_ok($plus_meth, 'Class::MOP::Method::Overload');
  50     is($plus_meth->operator, '+');
  51     is($plus_meth->name, '(+');
  52     is($plus_meth->body, $plus_impl);
  53     is($plus_meth->package_name, 'Foo::Overloaded');
  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);
  93 }
  94
  95 done_testing;