tests for _load_module
[gitmo/Role-Tiny.git] / t / overload.t
index 41ab0c7..71ee3c7 100644 (file)
@@ -11,7 +11,7 @@ BEGIN {
   use overload
     '""' => \&as_string,
     '0+' => 'as_num',
-    bool => sub(){1},
+    bool => sub(){0},
     fallback => 1;
 }
 
@@ -24,19 +24,50 @@ BEGIN {
 
 BEGIN {
   package MyClass2;
-  use overload fallback => 0;
+  use overload
+    fallback => 0,
+    '""' => 'class_string',
+    '0+' => sub { 42 },
+    ;
   use Role::Tiny::With;
   with 'MyRole';
   sub new { bless {}, shift }
+  sub class_string { 'yarp' }
 }
 
-my $o = MyClass->new;
-is "$o", 'welp', 'subref overload';
-is 0+$o, 219, 'method name overload';
-ok !!$o, 'anon subref overload';
+BEGIN {
+  package MyClass3;
+  sub new { bless {}, shift }
+}
 
-my $o2 = MyClass2->new;
-eval { my $f = 0+$o2 };
-like $@, qr/no method found/, 'fallback value not overwritten';
+{
+  my $o = MyClass->new;
+  is "$o", 'welp', 'subref overload';
+  is sprintf('%d', $o), 219, 'method name overload';
+  ok !$o, 'anon subref overload';
+}
+
+{
+  my $o = MyClass2->new;
+  eval { my $f = 0+$o };
+  like $@, qr/no method found/, 'fallback value not overwritten';
+  is "$o", 'yarp', 'method name overload not overwritten';
+  is sprintf('%d', $o), 42, 'subref overload not overwritten';
+}
+
+{
+  my @o = (MyClass3->new) x 2;
+  my $copy = '';
+  for my $o (@o) {
+    Role::Tiny->apply_roles_to_object($o, 'MyRole')
+      unless $copy;
+    local $TODO = 'magic not applied to all ref copies on perl < 5.8.9'
+      if $copy && $] < 5.008009;
+    is "$o", 'welp', 'subref overload applied to instance'.$copy;
+    is sprintf('%d', $o), 219, 'method name overload applied to instance'.$copy;
+    ok !$o, 'anon subref overload applied to instance'.$copy;
+    $copy ||= ' copy';
+  }
+}
 
 done_testing;