X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FTypeDecorator.pm;h=2d1098d2322fb5e329974e8d725e160904c0b5f4;hb=28696c2e1c3e499b4613645f4d6ec02026c025aa;hp=16e4fe0ba71db72e721c127e86907daddf8a8317;hpb=7f95d0bf38da072ac2fba35dcfe29abfa62037a3;p=gitmo%2FMooseX-Types.git diff --git a/lib/MooseX/Types/TypeDecorator.pm b/lib/MooseX/Types/TypeDecorator.pm index 16e4fe0..2d1098d 100644 --- a/lib/MooseX/Types/TypeDecorator.pm +++ b/lib/MooseX/Types/TypeDecorator.pm @@ -16,6 +16,8 @@ use overload( my $tc = $self->{__type_constraint}; return 0+$tc; }, + # workaround for perl 5.8.5 bug + '==' => sub { 0+$_[0] == 0+$_[1] }, '""' => sub { my $self = shift @_; if(blessed $self) { @@ -120,8 +122,10 @@ and for a class type, the class. sub isa { my $self = shift; return - $self->__type_constraint->isa(@_) - || $self->_try_delegate('isa', @_); + blessed $self + ? $self->__type_constraint->isa(@_) + || $self->_try_delegate( 'isa', @_ ) + : $self->SUPER::isa(@_); } =head2 can @@ -130,7 +134,13 @@ handle $self->can since AUTOLOAD can't. =cut -sub can { shift->_try_delegate('can', @_) } +sub can { + my $self = shift; + + return blessed $self + ? $self->_try_delegate( 'can', @_ ) + : $self->SUPER::can(@_); +} =head2 _throw_error @@ -188,7 +198,7 @@ sub _try_delegate { last; } $search_tc = $search_tc->parent; - last unless $search_tc->is_subtype_of('Object'); + last unless $search_tc && $search_tc->is_subtype_of('Object'); } }