fix overloads using method names in roles
Graham Knop [Wed, 19 Feb 2014 21:44:21 +0000 (16:44 -0500)]
lib/Role/Tiny.pm
t/overload.t [new file with mode: 0644]

index 2922fc2..ca3d0fe 100644 (file)
@@ -361,7 +361,20 @@ sub _install_methods {
 
   foreach my $i (grep !exists $has_methods{$_}, keys %$methods) {
     no warnings 'once';
-    *{_getglob "${to}::${i}"} = $methods->{$i};
+    my $glob = _getglob "${to}::${i}";
+    *$glob = $methods->{$i};
+
+    # overloads using method names have the method stored in the scalar slot
+    next
+      unless $i =~ /^\(/
+        && defined &overload::nil
+        && $methods->{$i} == \&overload::nil;
+
+    my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
+    next
+      unless defined $overload;
+
+    *$glob = \$overload;
   }
 
   $me->_install_does($to);
diff --git a/t/overload.t b/t/overload.t
new file mode 100644 (file)
index 0000000..9e83c55
--- /dev/null
@@ -0,0 +1,30 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+BEGIN {
+  package MyRole;
+  use Role::Tiny;
+
+  sub as_string { "welp" }
+  sub as_num { 219 }
+  use overload
+    '""' => \&as_string,
+    '0+' => 'as_num',
+    bool => sub(){1},
+    fallback => 1;
+}
+
+BEGIN {
+  package MyClass;
+  use Role::Tiny::With;
+  with 'MyRole';
+  sub new { bless {}, shift }
+}
+
+my $o = MyClass->new;
+is "$o", 'welp', 'subref overload';
+is 0+$o, 219, 'method name overload';
+ok !!$o, 'anon subref overload';
+
+done_testing;