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 done_testing;