more tests, overloading clearly hosed

lib/metamethod.pm

@@ -1,4 +1,5 @@
-package metamethod; # make my methods meta!
+package metamethod;
+use 5.010; # uvar magic does not work prior to version 10
 use strict;
 use warnings;
 
@@ -24,22 +25,27 @@ sub import {
   if (reftype $code eq 'SCALAR') {
     $code = $caller->can($$code);
     Carp::confess("can't find metamethod via name ${ $arg->{metamethod} }")
-      unless reftype $code eq 'CODE';
+      unless $code and reftype $code eq 'CODE';
   }
 
   if (do { no strict 'refs'; defined *{"$caller\::$metamethod"}{CODE} }) {
     Carp::confess("can't install metamethod as $metamethod; already defined");
   }
 
-  my $handle_overloads;
-  if ($arg->{handle_overloads}) {
-    if (reftype $arg->{handle_overloads} eq 'CODE') {
-      $to_install{__overload_metamethod__} = $arg->{handle_overloads};
-      $handle_overloads = '__overload_metamethod__';
-    } elsif ($arg->{handle_overloads} eq 'metamethod') {
-      $handle_overloads = $metamethod;
+  my $overloads;
+  if ($arg->{overloads}) {
+    # XXX: detect name conflicts here -- rjbs, 2009-03-22
+    if ($arg->{overloads} eq 'metamethod') {
+      $overloads = $metamethod;
+    } elsif (! ref $arg->{overloads}) {
+      Carp::confess("unknown value for overloads");
+    } elsif (reftype $arg->{overloads} eq 'CODE') {
+      $to_install{__overload_metamethod__} = $arg->{overloads};
+      $overloads = '__overload_metamethod__';
+    } elsif (reftype $arg->{overloads} eq 'SCALAR') {
+      $overloads = ${ $arg->{overloads} };
     } else {
-      Carp::confess("unknown value for handles_overloads");
+      Carp::confess("unknown value for overloads");
     }
   }
 
@@ -50,8 +56,8 @@ sub import {
     data     => sub { \$method_name },
     fetch    => $self->_gen_fetch_magic({
       metamethod => $metamethod,
+      overloads  => $overloads,
       passthru   => $arg->{passthru},
-      handle_overloads => $handle_overloads,
     });
 
   $to_install{ $metamethod } = sub {
@@ -71,17 +77,17 @@ sub _gen_fetch_magic {
   my ($self, $arg) = @_;
 
   my $metamethod = $arg->{metamethod};
+  my $overloads  = $arg->{overloads};
   my $passthru   = $arg->{passthru};
-  my $handle_overloads = $arg->{handle_overloads};
 
   return sub {
     return if $_[2] ~~ $passthru;
 
     my $is_ol = (substr $_[2], 0, 1) eq '(';
-    return if $is_ol and ! $handle_overloads;
+    return if $is_ol and ! $overloads;
 
     ${ $_[1] } = $_[2];
-    $_[2] = $is_ol ? $handle_overloads : '__metamethod__';
+    $_[2] = $is_ol ? $overloads : $metamethod;
     return;
   };
 }

t/misc-errors.t

@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+use metamethod ();
+
+{
+  my $ok = eval {
+    package Foo;
+    sub __metamethod__ { "just here to cause problems" }
+    metamethod->import( sub { 1 } );
+    1;
+  };
+
+  my $error = $@;
+  ok( ! $ok, "we can't use metamethod without custom name if conflict exists");
+  like($error, qr/already/, "... got the right error, more or less");
+}
+
+{
+  my $ok = eval {
+    package Bar;
+    metamethod->import(metamethod => \'doesnt_exist');
+    1;
+  };
+
+  my $error = $@;
+  ok( ! $ok, "we can't provide metamethod by name if it doesn't exist");
+  like($error, qr/can't find/, "... got the right error, more or less");
+}

t/overloads.t

@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+use metamethod ();
+
+TODO: {
+  local $TODO = 'figure out how the crap overloading works';
+
+  my @calls;
+  {
+    package OLP; # overloads pass through
+    metamethod->import(
+      metamethod => sub {
+        my ($self, $method, $args) = @_;
+        push @calls, $method;
+        return $method;
+      },
+      overloads  => 'metamethod',
+      passthru   => [ 'ISA' ],
+    );
+  }
+
+  my $olp = bless {} => 'OLP';
+  my $str = "$olp";
+  is($str, '(""', "we stringified to the stringification method name");
+}