Skip Menu |
 

This queue is for tickets about the UNIVERSAL-isa CPAN distribution.

Report information
The Basics
Id: 17722
Status: resolved
Worked: 1.5 hours (90 min)
Priority: 0/
Queue: UNIVERSAL-isa

People
Owner: Nobody in particular
Requestors: chromatic [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.05
Fixed in: (no value)



Subject: UNIVERSAL::isa ignores overloaded can()
Download (untitled) / with headers
text/plain 522b
UNIVERSAL::isa calls UNIVERSAL::can() as a function, not a method, disallowing the use of a proxy object that implements its own can(), for example. The test patch adds a test for this as well as the standard behavior promised by the UNIVERSAL documentation of checking for hashiness of a reference. Though that's not as nice as using Scalar::Util::reftype(), this module should be transparent. The other patch refactors the implementation of the module to be clearer about what's happening as well as to fix both bugs.
Subject: isa.patch
Download isa.patch
text/x-diff 3k
diff -ur lib/UNIVERSAL/isa.pm~ UNIVERSAL-isa/lib/UNIVERSAL/isa.pm --- lib/UNIVERSAL/isa.pm~ 2005-11-07 00:17:31.000000000 -0800 +++ lib/UNIVERSAL/isa.pm 2006-01-14 01:03:54.000000000 -0800 @@ -22,55 +22,67 @@ *{caller() . "::isa"} = \&UNIVERSAL::isa if (@_ > 1 and $_[1] eq "isa"); } -sub UNIVERSAL::isa { - # not an object or a class name, we can skip - unless ( blessed($_[0]) ) +sub UNIVERSAL::isa +{ + goto &$orig if $recursing; + my $type = invocant_type( @_ ); + $type->( @_ ); +} + +sub invocant_type +{ + my $invocant = shift; + return \&nonsense unless defined( $invocant ); + return \&object_or_class if blessed( $invocant ); + return \&reference if ref( $invocant ); + return \&nonsense unless $invocant; + return \&object_or_class; +} + +sub nonsense +{ + report_warning( 'on invalid invocant' ); + return; +} + +sub object_or_class +{ + report_warning(); + + local $@; + local $recursing = 1; + + if ( my $override = eval { $_[0]->can( 'isa' ) } ) { - if (not defined $_[0] or length $_[0] == 0) { - # it's not a class, either... Retain orig behavior - # for garbage as first arg - goto &$orig; - } else { - # it's a string, which means it can be a class - my $symtable = \%::; - my $found = 1; - - for my $symbol (split( '::', $_[0] )) { - $symbol .= '::'; - unless (exists $symtable->{$symbol}) { - $found = 0; - last; - } - $symtable = $symtable->{$symbol}; - } - - # if it's not a class then it doesn't have it's own dispatch, - # so we retain the original behavior - goto &$orig unless $found; + unless ( $override == \&UNIVERSAL::isa ) + { + my $obj = shift; + return $obj->$override( @_ ); } } - # if the object will *really* run a different 'isa' when we invoke it we - # need to invoke it. On the other hand if it's not overridden, we just use - # the original behavior - goto &$orig if (UNIVERSAL::can($_[0], "isa") == \&UNIVERSAL::isa); - - # if we've been called from an overridden isa that we arranged to call, we - # are either SUPER:: or explicitly called. in both cases the original ISA - # behavior is expected. - goto &$orig if $recursing; + goto &$orig; +} - # the last possible case is that 'isa' is overridden - local $recursing = 1; - my $obj = shift; +sub reference +{ + report_warning( "Did you mean to use Scalar::Util::reftype() instead?" ); + goto &$orig; +} - if (warnings::enabled()) { - my $calling_sub = ( caller( 1 ) )[3] || ''; - warnings::warn( "Called UNIVERSAL::isa() as a function, not a method" ) - if $calling_sub !~ /::isa$/; - } +sub report_warning +{ + my $extra = shift; + $extra = $extra ? " ($extra)" : ''; - return $obj->isa(@_); + if (warnings::enabled()) + { + my $calling_sub = ( caller( 2 ) )[3] || ''; + return if $calling_sub =~ /::isa$/; + warnings::warn( + "Called UNIVERSAL::isa() as a function, not a method$extra" + ) + } } __PACKAGE__; @@ -125,8 +137,6 @@ =head1 COPYRIGHT & LICENSE -Same as perl, blah blah blah, (c) 2005 +Same as perl, blah blah blah, (c) 2005 - 2006. =cut - -
Subject: universal_tests.patch
diff -ur t/basic.t~ UNIVERSAL-isa/t/basic.t --- t/basic.t~ 2005-11-07 00:17:31.000000000 -0800 +++ t/basic.t 2006-01-14 01:04:59.000000000 -0800 @@ -2,11 +2,12 @@ use strict; -use Test::More tests => 12; +use Test::More tests => 13; BEGIN { use_ok("UNIVERSAL::isa", "isa") }; -no warnings "UNIVERSAL::isa"; +# no warnings "UNIVERSAL::isa"; +use warnings; { package Foo; @@ -51,4 +52,7 @@ ok(isa($x, "Baz"), "baz is itself"); ok(!isa($x, "Crap"), "baz isn't crap"); ok(isa($x, "Dung"), "it's dung"); - +{ + use warnings 'UNIVERSAL::isa'; + ok( isa( {}, 'HASH' ), "hash reference isa HASH" ); +} diff -ur t/bugs.t~ UNIVERSAL-isa/t/bugs.t --- t/bugs.t~ 2005-11-07 00:17:31.000000000 -0800 +++ t/bugs.t 2006-01-14 01:02:27.000000000 -0800 @@ -1,8 +1,8 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl use strict; -use Test::More tests => 7; +use Test::More tests => 8; BEGIN { use_ok('UNIVERSAL::isa', 'isa') }; @@ -33,6 +33,24 @@ } } +# really delegates calls to Foo +{ + package FooProxy; + + sub new + { + my $class = shift; + my $foo = Foo->new( @_ ); + bless \$foo, $class; + } + + sub can + { + my $self = shift; + return $$self->can( @_ ); + } +} + # wraps a Foo object { package Quux; @@ -88,3 +106,5 @@ ok( isa( $qibble, 'Qibble' ), '... can test ISA on landmines'); +my $proxy = FooProxy->new(); +isa_ok( $proxy, 'Foo' );
From: nuffin [...] cpan.org
Download (untitled) / with headers
text/plain 208b
do you have co-maint for UNIVERSAL::isa? I'm über swamped (just got back from abroad) so it'll take me a while (maybe till march 2nd or so) to release this. If you can get around to releasing it feel free
CC: chromatic [...] cpan.org
Subject: Re: [rt.cpan.org #17722] UNIVERSAL::isa ignores overloaded can()
Date: Sun, 19 Feb 2006 16:12:29 -0800
To: bug-UNIVERSAL-isa [...] rt.cpan.org
From: chromatic <chromatic [...] wgz.org>
Download (untitled) / with headers
text/plain 378b
On Sunday 19 February 2006 11:45, Guest via RT wrote: Show quoted text
> do you have co-maint for UNIVERSAL::isa? > > I'm über swamped (just got back from abroad) so it'll take me a while > (maybe till march 2nd or so) to release this. > > If you can get around to releasing it feel free
I don't think I have co-maint. If I do, I can release a new version in the next couple of days. -- c
Subject: Re: [rt.cpan.org #17722] UNIVERSAL::isa ignores overloaded can()
Date: Mon, 20 Feb 2006 00:30:44 -0600
To: bug-UNIVERSAL-isa [...] rt.cpan.org
From: "Joshua ben Jore" <twists [...] gmail.com>
Download (untitled) / with headers
text/plain 1.2k
On 2/19/06, chromatic <chromatic@wgz.org> wrote: Show quoted text
> On Sunday 19 February 2006 21:38, Joshua ben Jore wrote: >
> > Why are you two bccing me on this ticket? Are you just ccing p5p? I > > didn't recognize any evidence of that in the email headers.
> > Hm, looks like *you* have co-maint on the module. That's odd.
Lots of people have co-maint on this, you included. I dunno. nothingmuch, did I ever tell you on perlmonks that I wanted to be a maintainer for this? At least remind me. I wouldn't be surprised if I'd talked to you about it but I don't remember it. UNIVERSAL::isa AUTRIJUS co-maint UNIVERSAL::isa CHROMATIC co-maint UNIVERSAL::isa DKAMHOLZ co-maint UNIVERSAL::isa GAAL co-maint UNIVERSAL::isa JJORE co-maint UNIVERSAL::isa MSTROUT co-maint UNIVERSAL::isa NUFFIN first-come UNIVERSAL::isa STEVAN co-maint There's a bug in the class splitting code. It does C<< split '::', $_[0] >> but doesn't accomodate apostrophe as a separator. C<< split /(?::|')/, $_[0] >> would be more correct. When I responded to ask why I was getting copied on the ticket I sent it directly to chromatic and nuffin but I've replied back to the list now that it's clear why I'm getting this and I'm mentioning the bug. Josh
CC: undisclosed-recipients: ;
Subject: Re: [rt.cpan.org #17722] UNIVERSAL::isa ignores overloaded can()
Date: Mon, 20 Feb 2006 20:21:07 +0200
To: Joshua ben Jore via RT <bug-UNIVERSAL-isa [...] rt.cpan.org>
From: Yuval Kogman <nothingmuch [...] woobling.org>
Download (untitled) / with headers
text/plain 1.7k
On Mon, Feb 20, 2006 at 01:31:38 -0500, Joshua ben Jore via RT wrote: Show quoted text
> > <URL: http://rt.cpan.org/Ticket/Display.html?id=17722 > > > On 2/19/06, chromatic <chromatic@wgz.org> wrote:
> > On Sunday 19 February 2006 21:38, Joshua ben Jore wrote: > >
> > > Why are you two bccing me on this ticket? Are you just ccing p5p? I > > > didn't recognize any evidence of that in the email headers.
> > > > Hm, looks like *you* have co-maint on the module. That's odd.
> > Lots of people have co-maint on this, you included. I dunno. > nothingmuch, did I ever tell you on perlmonks that I wanted to be a > maintainer for this? At least remind me. I wouldn't be surprised if > I'd talked to you about it but I don't remember it.
I remember something vague but I really don't know what it is know... Woulr you like me to remove you? Show quoted text
> UNIVERSAL::isa AUTRIJUS co-maint > UNIVERSAL::isa CHROMATIC co-maint > UNIVERSAL::isa DKAMHOLZ co-maint > UNIVERSAL::isa GAAL co-maint > UNIVERSAL::isa JJORE co-maint > UNIVERSAL::isa MSTROUT co-maint > UNIVERSAL::isa NUFFIN first-come > UNIVERSAL::isa STEVAN co-maint
The bunch of other people got comaint when I went abroad so that potential bugs would be distributed. They are comaintainers because I trust these people to handle my code in my absence. Show quoted text
> There's a bug in the class splitting code. It does C<< split '::', > $_[0] >> but doesn't accomodate apostrophe as a separator. C<< split > /(?::|')/, $_[0] >> would be more correct.
Oi vey... ;-) It does not ring a bell though - i think you wanted something else. chromatic - can you roll that into the new release thing? -- () Yuval Kogman <nothingmuch@woobling.org> 0xEBD27418 perl hacker & /\ kung foo master: /me kicks %s on the nose: neeyah!!!!!!!!!!!!!!!!!
Download (untitled)
application/pgp-signature 189b

Message body not shown because it is not plain text.

Subject: Re: [rt.cpan.org #17722] UNIVERSAL::isa ignores overloaded can()
Date: Mon, 20 Feb 2006 13:06:12 -0600
To: bug-UNIVERSAL-isa [...] rt.cpan.org
From: "Joshua ben Jore" <twists [...] gmail.com>
Download (untitled) / with headers
text/plain 305b
Show quoted text
> It does not ring a bell though - i think you wanted something else.
Yeah, I don't know what it was. We didn't talk about it in email so I've no record of it. I've no pressing need to be a maintainer of this module but isn't horrible either. If something comes up, maybe it'll be useful sometime. Josh


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.