t/overload.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 use Test::More;
   4
   5 BEGIN {
   6   package MyRole;
   7   use Role::Tiny;
   8
   9   sub as_string { "welp" }
  10   sub as_num { 219 }
  11   use overload
  12     '""' => \&as_string,
  13     '0+' => 'as_num',
  14     bool => sub(){0},
  15     fallback => 1;
  16 }
  17
  18 BEGIN {
  19   package MyClass;
  20   use Role::Tiny::With;
  21   with 'MyRole';
  22   sub new { bless {}, shift }
  23 }
  24
  25 BEGIN {
  26   package MyClass2;
  27   use overload
  28     fallback => 0,
  29     '""' => 'class_string',
  30     '0+' => sub { 42 },
  31     ;
  32   use Role::Tiny::With;
  33   with 'MyRole';
  34   sub new { bless {}, shift }
  35   sub class_string { 'yarp' }
  36 }
  37
  38 BEGIN {
  39   package MyClass3;
  40   sub new { bless {}, shift }
  41 }
  42
  43 {
  44   my $o = MyClass->new;
  45   is "$o", 'welp', 'subref overload';
  46   is sprintf('%d', $o), 219, 'method name overload';
  47   ok !$o, 'anon subref overload';
  48 }
  49
  50 {
  51   my $o = MyClass2->new;
  52   eval { my $f = 0+$o };
  53   like $@, qr/no method found/, 'fallback value not overwritten';
  54   is "$o", 'yarp', 'method name overload not overwritten';
  55   is sprintf('%d', $o), 42, 'subref overload not overwritten';
  56 }
  57
  58 {
  59   my @o = (MyClass3->new) x 2;
  60   my $copy = '';
  61   for my $o (@o) {
  62     Role::Tiny->apply_roles_to_object($o, 'MyRole')
  63       unless $copy;
  64     local $TODO = 'magic not applied to all ref copies on perl < 5.8.9'
  65       if $copy && $] < 5.008009;
  66     is "$o", 'welp', 'subref overload applied to instance'.$copy;
  67     is sprintf('%d', $o), 219, 'method name overload applied to instance'.$copy;
  68     ok !$o, 'anon subref overload applied to instance'.$copy;
  69     $copy ||= ' copy';
  70   }
  71 }
  72
  73 done_testing;