| Subject: | Problem with Class-Multimethods's superclass() |
| Date: | Mon, 09 Jun 2008 15:00:44 -0500 |
| To: | bug-Class-Multimethods [...] rt.cpan.org |
| From: | Harry Danilevsky <hdanilevsky [...] deerfieldcapital.com> |
Hello,
It appears that there's a bug in Class-Multimethods-1.70 module,
related to the use of superclass() subroutine.
My Google search has turned up just one relevant entry, a question from a 2005 mail archive,
but perhaps not a lot of people are using superclass().
I'm running perl 5.8.7 on Solaris SunOS strad 5.8 Generic_117350-45
sun4u sparc SUNW,Sun-Fire-V210 Solaris.
When calling methods using the superclass() mechanism, Class::Multimethod
passes internally created references to arguments ('Class::Multimethods::SUPERCLASS*'
objects) instead of the actual arguments. This bug can be easily
reproduced by running a slightly modified version of a demo script
that comes with the distribution, demo.numstr.pl :
8<---- cut here -------------
#! /usr/local/bin/perl -w
use Class::Multimethods;
multimethod mm => ('#') => sub
{
print "mm(number): ", $_[0], "\n";
mm(superclass($_[0]));
};
multimethod mm => ('$') => sub
{
print "mm(string): ", $_[0], "\n";
};
sub try
{
print "$_[0]\n";
eval $_[0];
print "---\n";
}
try q{ mm(1) };
try q{ mm("2") };
try q{ mm("three") };
try q{ mm(4 . "") };
try q{ mm("5" + 0) };
8<---- cut here -------------
Output:
/home/harry/.cpan/build/Class-Multimethods-1.70> perl demo/demo.numstr.pl
mm(1)
mm(number): 1
mm(string): Class::Multimethods::SUPERCLASS_OF::#=SCALAR(0x15b2d8)
---
mm("2")
mm(string): 2
---
mm("three")
mm(string): three
---
mm(4 . "")
mm(string): 4
---
mm("5" + 0)
mm(number): 5
mm(string): Class::Multimethods::SUPERCLASS_OF::#=SCALAR(0x1f5c34)
---
======================================
It looks like in Class::Multimethods::make_dispatch() the few lines of
code dereferencing Class::Multimethods::SUPERCLASS* objects before
calling the actual method, are in the wrong place: they should be moved up,
before the first $code->(@_) call.
Below is the proposed patch to Class::Multimethods.pm. After applying this patch,
the example script above produced the expected output:
mm(1)
mm(number): 1
mm(string): 1
---
mm("2")
mm(string): 2
---
mm("three")
mm(string): three
---
mm(4 . "")
mm(string): 4
---
mm("5" + 0)
mm(number): 5
mm(string): 5
---
========================================
*** lib/Class/Multimethods.pm Mon Jun 9 12:14:03 2008
--- /usr/local/lib/perl5/site_perl/5.8.7/Class/Multimethods.pm Sat Apr 8 21:44:12 2000
***************
*** 146,164 ****
}
chop $sig;
- my @types = split /,/, $sig;
-
- for (my $i=0; $i<@types; $i++)
- {
- $_[$i] = ${$_[$i]}
- if index($types[$i],'Class::Multimethods::SUPERCLASS')==0;
- }
-
my $code = $Class::Multimethods::dispatch{'NAME'}{$sig}
|| $Class::Multimethods::cached{'NAME'}{$sig};
return $code->(@_) if ($code);
my %tried = (); # USED TO AVOID MULTIPLE MATCHES ON SAME SIG
my @code; # STORES LIST OF EQUALLY-CLOSE MATCHING SUBS
my @candidates = ( [@types] ); # STORES POSSIBLE MATCHING SIGS
--- 146,162 ----
}
chop $sig;
my $code = $Class::Multimethods::dispatch{'NAME'}{$sig}
|| $Class::Multimethods::cached{'NAME'}{$sig};
return $code->(@_) if ($code);
+ my @types = split /,/, $sig;
+ for (my $i=1; $i<@types; $i++)
+ {
+ $_[$i] = ${$_[$i]}
+ if index($types[$i],'Class::Multimethods::SUPERCLASS')==0;
+ }
my %tried = (); # USED TO AVOID MULTIPLE MATCHES ON SAME SIG
my @code; # STORES LIST OF EQUALLY-CLOSE MATCHING SUBS
my @candidates = ( [@types] ); # STORES POSSIBLE MATCHING SIGS
=====================================
Regards,
Harry Danilevsky
harry@deerfieldcapital.com